home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tools / doloop / DOLIB.MAC.f next >
Encoding:
Text File  |  1989-03-04  |  112.7 KB  |  2,867 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 2.1
  3. C---------------------------------------------------------
  4. C
  5. C    - REMOVE TABS
  6. C    - PROGRAM UNITS RE-ORDERED
  7. C    - ADDITIONAL YADEFS INCLUSIONS REMOVED
  8. C    - DEFINES MOVED
  9. C    - UNSPLIT LINES REMOVED
  10. C    - CHANGE ZPTYPE TO ZPTYPE
  11. C    - ADD GETLAB AND NAMEP FROM ISTUD
  12. C    - USE NEW TOKEN WRITE ROUTINE, CHANGE IODTKO/IODCMO FOR
  13. C      TKNCHN AND USE ZTKPTI AS AN INITIALISATION CALL.
  14. C
  15. C---------------------------------------------------------
  16. C    TOOLPACK/1    Release: 2.1
  17. C---------------------------------------------------------
  18. C---------------------------------------------------------
  19. C    TOOLPACK/1    Release: 2.1
  20. C---------------------------------------------------------
  21. C---------------------------------------------------------
  22. C    TOOLPACK/1    Release: 2.1
  23. C---------------------------------------------------------
  24.  
  25.  
  26.  
  27.  
  28.  
  29.  
  30.  
  31.  
  32. C                                   parameter length
  33.  
  34.  
  35.  
  36.  
  37.  
  38.  
  39.  
  40.  
  41.  
  42. C following are for ZYCSDT (Canonicalise Symbol Data Types)
  43. C
  44. C--------   NODETP.MAC
  45. C ------------------------------------------------------------------------
  46. C
  47. C  BUFFER ROUTINE FOR ZYNTYP, A PARAMETER OF 0 IS ILLEGAL.......
  48. C
  49.       INTEGER FUNCTION NODETP(NODE)
  50.  
  51.       INTEGER NODE, ZYNTYP
  52.       EXTERNAL ZYNTYP
  53.  
  54.       IF(NODE .EQ. 0) THEN
  55.         NODETP = -1
  56.       ELSE
  57.         NODETP = ZYNTYP(NODE)
  58.       ENDIF
  59.  
  60.       END
  61. C--------   GETLAB.MAC
  62. C ------------------------------------------------------------------------
  63. C    GETLAB - Get a replacement label
  64. C
  65.       SUBROUTINE GETLAB(LABNOD,REPLAB,FOUND)
  66. C Given the label or label reference node LABNOD, return a replacement
  67. C label REPLAB based on the replacement list OLDLBS/NEWLBS/NRLBS filled
  68. C by SETLAB.  If label found, set FOUND = .TRUE., otherwise
  69. C FOUND = .FALSE.
  70.  
  71.       INTEGER LABNOD, REPLAB(6)
  72.       LOGICAL FOUND
  73.  
  74.       COMMON/IO/ IODTKN,IODCMI,IODCMT,IODTKO,IODCMO,TKNCHN
  75.       INTEGER IODTKN,IODCMI,IODCMT,IODTKO,IODCMO,TKNCHN
  76.  
  77.       COMMON/LABLST/OLDLBS,NEWLBS,NRLBS
  78.       INTEGER OLDLBS(6,200),NEWLBS(6,200),NRLBS
  79.  
  80.       SAVE
  81.  
  82.       INTEGER TYPE,SYMVAL(8),LABLO(6),I
  83.  
  84.       INTEGER ZYDOWN,ZYNTYP,EQUAL
  85.       EXTERNAL ZYDOWN,ZYNTYP,ZYGTSY,ZYGTST,SCOPY
  86. C Check that LABNOD is of type N_LABEL or N_LABELREF.
  87.       TYPE = ZYNTYP(LABNOD)
  88.       IF (TYPE .NE. 115 .AND. TYPE .NE. 116)
  89.      +      CALL ERROR('GETLAB: Node of Inappropriate Type.')
  90.  
  91. C Get the label and locate it in the label list.
  92.       CALL ZYGTSY(-ZYDOWN(LABNOD),SYMVAL)
  93.       CALL ZYGTST(SYMVAL(2),LABLO)
  94.       DO 10 I=1,NRLBS
  95.          IF (EQUAL(LABLO,OLDLBS(1,I)) .EQ. -2) THEN
  96.            CALL SCOPY(NEWLBS(1,I),1,REPLAB,1)
  97.            FOUND = .TRUE.
  98.            RETURN
  99.          ENDIF
  100.    10 CONTINUE
  101.  
  102. C Label not found on list.
  103.       FOUND = .FALSE.
  104.  
  105.       END
  106. C--------   NAMEP.MAC
  107.       INTEGER FUNCTION NAMEP(NODE,NAME)
  108. C Return 'yes' or 'no' according to whether the subtree rooted
  109. C at NODE contains a node of type N_NAME whose associated string
  110. C is NAME.
  111.  
  112.         COMMON/IO/ IODTKN,IODCMI,IODCMT,IODTKO,IODCMO,TKNCHN
  113.         INTEGER IODTKN,IODCMI,IODCMT,IODTKO,IODCMO,TKNCHN
  114.  
  115.       SAVE
  116.       INTEGER NODE, POINTR, TYPE,
  117.      +          STACK(500),NAME(*),
  118.      +          SYMVAL(8),TEXT(1322)
  119.       INTEGER ZYROOT, ZYNTYP, ZYDOWN, ZYNEXT, ZYUP, PUSH, POP,
  120.      +          EQUAL
  121.       EXTERNAL ZYINPT, ZYROOT, ZPTINT, ZYNTYP, ZYDOWN, ZCHOUT,
  122.      +           ZYNEXT, ZYUP, PUSH, POP, ZYGTSY,
  123.      +           ZYGTST, ZPTMES, EQUAL
  124.  
  125.       STACK(1) = -1
  126.  
  127.       POINTR = NODE
  128. 10      CONTINUE
  129.       TYPE = ZYNTYP(POINTR)
  130.       IF(TYPE .EQ. 108) THEN
  131.          CALL ZYGTSY(-ZYDOWN(POINTR),SYMVAL)
  132.          CALL ZYGTST(SYMVAL(2),TEXT)
  133.          IF(EQUAL(TEXT,NAME) .EQ. -2) THEN
  134.             NAMEP = -2
  135.             RETURN
  136.          END IF
  137.       END IF
  138.       IF(PUSH(POINTR,STACK) .EQ. -1)CALL ERROR('Stack Full.',2)
  139.       POINTR = ZYDOWN(POINTR)
  140. C If POINTR > 0, node is not a leaf.
  141.       IF(POINTR .GT. 0) GO TO 10
  142. C Node is a leaf.
  143. C Can't go down, try next unless we are at NODE.
  144.       POINTR = POP(STACK)
  145.       IF(POINTR .EQ. NODE) THEN
  146.          NAMEP = -3
  147.          RETURN
  148.       END IF
  149.       POINTR = ZYNEXT(POINTR)
  150.       IF(POINTR .GT. 0) GO TO 10
  151. C Can't go next, pop until next is possible or return to NODE is complete.
  152.         POINTR = POP(STACK)
  153.       IF(POINTR .EQ. -1 .OR. POINTR .EQ. NODE) THEN
  154.          NAMEP = -3
  155.          RETURN
  156.       END IF
  157. 20      CONTINUE
  158.       POINTR = ZYNEXT(POINTR)
  159.       IF(POINTR .GT. 0) THEN
  160.          GO TO 10
  161.       ELSE
  162.          POINTR = POP(STACK)
  163.          IF(POINTR .EQ. -1 .OR. POINTR .EQ. NODE) THEN
  164.             NAMEP = -3
  165.             RETURN
  166.          END IF
  167.          GO TO 20
  168.       END IF
  169.       END
  170. C--------   COMOUT.MAC
  171. C ----------------------------------------------------------------------
  172. C
  173. C       C O M O U T  -   Output Block of Comments
  174. C
  175.  
  176.         SUBROUTINE COMOUT(SNUM)
  177. C Output one or more comments at statement number SNUM.
  178.         INTEGER SNUM
  179.  
  180.         INTEGER BUFF(134)
  181.  
  182.         COMMON/IO/ IODTKN,IODCMI,IODCMT,IODTKO,IODCMO,TKNCHN
  183.         INTEGER IODTKN,IODCMI,IODCMT,IODTKO,IODCMO,TKNCHN
  184.  
  185.         INTEGER ZYGTCM,ZYGNCM,LENGTH
  186.         EXTERNAL ZYGTCM,ZYGNCM,LENGTH,ZTOKWR
  187.  
  188. C---------------------------------------------------------
  189. C    TOOLPACK/1    Release: 2.1
  190. C---------------------------------------------------------
  191. C
  192. C  TKLAST = LAST TOKEN NUMBER
  193. C
  194.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  195.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  196.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  197.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  198.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  199.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  200.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  201.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  202.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  203.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  204.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  205.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  206.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  207.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  208.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  209.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  210.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  211.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  212.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  213.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  214.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  215.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  216.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  217.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  218.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  219.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  220.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  221.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  222.  
  223.  
  224.         SAVE
  225.  
  226.  100    IF (ZYGTCM(IODCMT,SNUM,BUFF).EQ.-2) THEN
  227.  200        CALL ZTOKWR(TCMMNT,LENGTH(BUFF),BUFF,TKNCHN)
  228.             IF (ZYGNCM(IODCMT,BUFF).EQ.-2) GO TO 200
  229.         END IF
  230.  
  231.         END
  232. C--------   COMPAR.MAC
  233.       INTEGER FUNCTION COMPAR(NODE1,NODE2)
  234. C If the subtree rooted at NODE1 and the subtree rooted at NODE2
  235. C are identical, return 'yes'; else return 'no'.
  236.  
  237.         COMMON/IO/ IODTKN,IODCMI,IODCMT,IODTKO,IODCMO,TKNCHN
  238.         INTEGER IODTKN,IODCMI,IODCMT,IODTKO,IODCMO,TKNCHN
  239.       SAVE
  240.  
  241.       INTEGER NODE1,NODE2,POINT1,POINT2,TYPE1,TYPE2,JUNK,
  242.      +          STACK1(500),STACK2(500),
  243.      +          SYMVAL(8),
  244.      +          TEXT1(1322),TEXT2(1322)
  245.  
  246.       INTEGER ZYNTYP,ZYDOWN,ZYNEXT,PUSH,POP,EQUAL
  247.  
  248.       EXTERNAL ZYNTYP,ZYDOWN,ZYNEXT,PUSH,POP,ZYGTSY,ZYGTST,EQUAL
  249.  
  250.       STACK1(1) = -1
  251.       STACK2(1) = -1
  252.  
  253.       POINT1 = NODE1
  254.       POINT2 = NODE2
  255. 10      CONTINUE
  256.       TYPE1 = ZYNTYP(POINT1)
  257.       TYPE2 = ZYNTYP(POINT2)
  258.       IF(TYPE1 .NE. TYPE2) THEN
  259. C Corresponding nodes have different types.
  260.          COMPAR = -3
  261.          RETURN
  262.       ELSE
  263. C The types of corresponding nodes are the same.  Put them on their
  264. C respective stacks.
  265.          IF(PUSH(POINT1,STACK1) .EQ. -1)
  266.      +        CALL ERROR('Stacks Full.',2)
  267.          JUNK = PUSH(POINT2,STACK2)
  268. C Are the corresponding nodes leaves?
  269.          POINT1 = ZYDOWN(POINT1)
  270.          POINT2 = ZYDOWN(POINT2)
  271. C Since the nodes are of the same type, they are either both
  272. C leaves or neither is a leaf.
  273.          IF(POINT1 .GT. 0) GO TO 10
  274. C Nodes are leaves.
  275. C If the leaves are unnamed skip the check for same string.
  276.          IF (POINT1 .EQ. 0) GO TO 100
  277. C The leaves are named.  Check if they point to the same string.
  278.          IF(TYPE1 .EQ. 108 .OR. TYPE1 .EQ. 40
  279.      +        .OR. TYPE1 .EQ. 115 .OR. TYPE1 .EQ. 116) THEN
  280.             CALL ZYGTSY(-POINT1,SYMVAL)
  281.             CALL ZYGTST(SYMVAL(2),TEXT1)
  282.             CALL ZYGTSY(-POINT2,SYMVAL)
  283.             CALL ZYGTST(SYMVAL(2),TEXT2)
  284.          ELSE
  285.             CALL ZYGTST(-POINT1,TEXT1)
  286.             CALL ZYGTST(-POINT2,TEXT2)
  287.          END IF
  288.          IF (EQUAL(TEXT1,TEXT2) .EQ. -3) THEN
  289. C Strings are different, subtrees are not identical.
  290.             COMPAR = -3
  291.             RETURN
  292.          END IF
  293. 100         CONTINUE
  294. C Can't go down, pop stacks and try next.
  295.          POINT1 = POP(STACK1)
  296.          POINT2 = POP(STACK2)
  297. C Have we arrived back at NODE1/NODE2?
  298.          IF (POINT1 .EQ. NODE1) THEN
  299.             IF (POINT2 .NE. NODE2) CALL ERROR('Internal Error 1.')
  300. C Subtrees are identical.
  301.             COMPAR = -2
  302.             RETURN
  303.          END IF
  304.          POINT1 = ZYNEXT(POINT1)
  305.          POINT2 = ZYNEXT(POINT2)
  306.          IF (POINT1 .GT. 0 .AND. POINT2 .GT. 0) GO TO 10
  307.          IF (POINT1 .GT. 0 .AND. POINT2 .LE. 0 .OR.
  308.      +         POINT2 .GT. 0 .AND. POINT1 .LE. 0) THEN
  309. C Subtrees have different structure - not identical.
  310.             COMPAR = -3
  311.             RETURN
  312.          END IF
  313. C Can't go next on either subtree. Pop stacks until next is possible
  314. C or return to NODE1/NODE2 is complete.
  315.            POINT1 = POP(STACK1)
  316.            POINT2 = POP(STACK2)
  317.          IF (POINT1 .EQ. -1) THEN
  318.             IF (POINT2 .NE. -1) CALL ERROR('Internal -1 2.')
  319. C Subtrees are identical.
  320.             COMPAR = -2
  321.             RETURN
  322.          END IF
  323.          IF (POINT1 .EQ. NODE1) THEN
  324.             IF (POINT2 .NE. NODE2) CALL ERROR('Internal -1 3.')
  325. C Subtrees are identical.
  326.             COMPAR = -2
  327.             RETURN
  328.          END IF
  329. 20         CONTINUE
  330.          POINT1 = ZYNEXT(POINT1)
  331.          POINT2 = ZYNEXT(POINT2)
  332.          IF (POINT1 .GT. 0 .AND. POINT2 .GT. 0) GO TO 10
  333.          IF (POINT1 .GT. 0 .AND. POINT2 .LE. 0 .OR.
  334.      +         POINT2 .GT. 0 .AND. POINT1 .LE. 0) THEN
  335. C Subtrees have different structure - not identical.
  336.             COMPAR = -3
  337.             RETURN
  338.          END IF
  339. C Can't go next on either subtree.
  340.            POINT1 = POP(STACK1)
  341.            POINT2 = POP(STACK2)
  342.          IF (POINT1 .EQ. -1) THEN
  343.             IF (POINT2 .NE. -1) CALL ERROR('Internal -1 4.')
  344. C Subtrees are identical.
  345.             COMPAR = -2
  346.             RETURN
  347.          END IF
  348.          IF (POINT1 .EQ. NODE1) THEN
  349.             IF (POINT2 .NE. NODE2) CALL ERROR('Internal -1 5.')
  350. C Subtrees are identical.
  351.             COMPAR = -2
  352.             RETURN
  353.          END IF
  354.          GO TO 20
  355.       END IF
  356.       END
  357. C--------   DEPSET.MAC
  358.       SUBROUTINE DEPSET(NODE,DNODES,NRDEPS)
  359.       INTEGER NODE,DNODES(*),NRDEPS
  360. C Given the assignment statement rooted at NODE, fill DNODES with the
  361. C nodes of the dependency set of the statement; i.e., the collection of
  362. C nodes of type N_NAME and of type N_ARELM in the expressions on both
  363. C sides of the assignment statement.  The number of elements of the
  364. C dependency set is returned as NRDEPS.
  365.  
  366.         COMMON/IO/ IODTKN,IODCMI,IODCMT,IODTKO,IODCMO,TKNCHN
  367.         INTEGER IODTKN,IODCMI,IODCMT,IODTKO,IODCMO,TKNCHN
  368.  
  369.       INTEGER POINTR,TYPE,STACK(500),RHSNOD,LHSNOD
  370.  
  371.       INTEGER ZYNTYP,ZYDOWN,ZYNEXT,PUSH,POP
  372.       EXTERNAL ZYNTYP,ZYDOWN,ZYNEXT,PUSH,POP
  373.  
  374.       SAVE
  375.  
  376.       NRDEPS = 0
  377.       STACK(1) = -1
  378.  
  379.       IF (ZYNTYP(NODE) .NE. 49) CALL ERROR('DEPSET: Input'
  380.      +      //'Node Not An Assignment Statement.')
  381.  
  382. C Find leaves of type N_NAME and array elements on the l.h.s.
  383.       POINTR = ZYDOWN(NODE)
  384.       IF (ZYNTYP(POINTR) .EQ. 115) POINTR = ZYNEXT(POINTR)
  385.       LHSNOD = POINTR
  386. 30      CONTINUE
  387.       IF(PUSH(POINTR,STACK) .EQ. -1)CALL ERROR('DEPSET:Stack Full.',
  388.      +                                             2)
  389.       TYPE = ZYNTYP(POINTR)
  390.       IF (TYPE .EQ. 104) THEN
  391. C Node is an array element.  Put into dependency set.
  392.          NRDEPS = NRDEPS + 1
  393.          DNODES(NRDEPS) = POINTR
  394.       END IF
  395.       POINTR = ZYDOWN(POINTR)
  396. C If POINTR > 0, node is not a leaf. If POINTR = 0, node is an unnamed
  397. C leaf.
  398.       IF (POINTR .GT. 0) GO TO 30
  399. C Node is a leaf. Put into dependency set if of type N_NAME.
  400.       POINTR = POP(STACK)
  401.       IF (TYPE .EQ. 108) THEN
  402.          NRDEPS = NRDEPS + 1
  403.          DNODES(NRDEPS) = POINTR
  404.       END IF
  405. C Leaf has been processed. Can't go down; try next unless we have
  406. C finished the l.h.s.
  407.       IF(POINTR .EQ. LHSNOD) GO TO 50
  408.       POINTR = ZYNEXT(POINTR)
  409.       IF(POINTR .GT. 0) GO TO 30
  410.  
  411. C Can't go next, pop until next is possible or return to LHSNOD is complete.
  412.         POINTR = POP(STACK)
  413.       IF(POINTR .EQ. -1 .OR. POINTR .EQ. LHSNOD) GO TO 50
  414. 40      CONTINUE
  415.       POINTR = ZYNEXT(POINTR)
  416.       IF(POINTR .GT. 0) THEN
  417.          GO TO 30
  418.       ELSE
  419.          POINTR = POP(STACK)
  420.          IF(POINTR .EQ. -1 .OR. POINTR .EQ. LHSNOD) GO TO 50
  421.          GO TO 40
  422.       END IF
  423.  
  424. 50      CONTINUE
  425.       STACK(1) = -1
  426.  
  427. C Find leaves of type N_NAME and array elements on the r.h.s.
  428.       POINTR = ZYDOWN(NODE)
  429.       IF (ZYNTYP(POINTR) .EQ. 115) POINTR = ZYNEXT(POINTR)
  430.       POINTR = ZYNEXT(POINTR)
  431.       RHSNOD = POINTR
  432. 10      CONTINUE
  433.       IF(PUSH(POINTR,STACK) .EQ. -1)CALL ERROR('DEPSET:Stack Full.',
  434.      +                                             2)
  435.       TYPE = ZYNTYP(POINTR)
  436.       IF (TYPE .EQ. 104) THEN
  437. C Node is an array element.  Put into dependency set.
  438.          NRDEPS = NRDEPS + 1
  439.          DNODES(NRDEPS) = POINTR
  440.       END IF
  441.       POINTR = ZYDOWN(POINTR)
  442. C If POINTR > 0, node is not a leaf. If POINTR = 0, node is an unnamed
  443. C leaf.
  444.       IF (POINTR .GT. 0) GO TO 10
  445. C Node is a leaf. Put into dependency set if of type N_NAME.
  446.       POINTR = POP(STACK)
  447.       IF (TYPE .EQ. 108) THEN
  448.          NRDEPS = NRDEPS + 1
  449.          DNODES(NRDEPS) = POINTR
  450.       END IF
  451. C Leaf has been processed. Can't go down; try next unless we have
  452. C finished the r.h.s.
  453.       IF(POINTR .EQ. RHSNOD) RETURN
  454.       POINTR = ZYNEXT(POINTR)
  455.       IF(POINTR .GT. 0) GO TO 10
  456. C Can't go next, pop until next is possible or return to RHSNOD is complete.
  457.         POINTR = POP(STACK)
  458.       IF(POINTR .EQ. -1 .OR. POINTR .EQ. RHSNOD) RETURN
  459. 20      CONTINUE
  460.       POINTR = ZYNEXT(POINTR)
  461.       IF(POINTR .GT. 0) THEN
  462.          GO TO 10
  463.       ELSE
  464.          POINTR = POP(STACK)
  465.          IF(POINTR .EQ. -1 .OR. POINTR .EQ. RHSNOD) RETURN
  466.          GO TO 20
  467.       END IF
  468.       END
  469. C--------   DOTRM.MAC
  470. C ----------------------------------------------------------------------
  471. C            D O T R M -  Output a DO statement  with a specified
  472. C                    termination label.
  473.  
  474.         SUBROUTINE DOTRM(NODE,TRMLBL,TKNCHN)
  475.         INTEGER NODE,TRMLBL(*),TKNCHN
  476.  
  477.         INTEGER STYPE,PTR,DUMMY(2)
  478.  
  479. C---------------------------------------------------------
  480. C    TOOLPACK/1    Release: 2.1
  481. C---------------------------------------------------------
  482. C
  483. C  TKLAST = LAST TOKEN NUMBER
  484. C
  485.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  486.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  487.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  488.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  489.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  490.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  491.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  492.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  493.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  494.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  495.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  496.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  497.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  498.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  499.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  500.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  501.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  502.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  503.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  504.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  505.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  506.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  507.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  508.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  509.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  510.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  511.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  512.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  513.  
  514.  
  515.         INTEGER ZYNTYP,ZYDOWN,ZYNEXT
  516.         EXTERNAL ZYNTYP,ZYDOWN,ZYNEXT,ZTOKWR,YLEAF,XDOTRM,ERROR
  517.  
  518.         DATA DUMMY(1)/129/
  519.  
  520.         PTR=NODE
  521.         STYPE=ZYNTYP(PTR)
  522.         PTR=ZYDOWN(PTR)
  523.         IF (PTR.NE.0) THEN
  524.             IF (ZYNTYP(PTR).EQ.115) THEN
  525.                 CALL YLEAF(PTR,TKNCHN)
  526.                 PTR=ZYNEXT(PTR)
  527.             END IF
  528.         END IF
  529.       IF (STYPE .EQ. 61) THEN
  530.            CALL XDOTRM(PTR,TRMLBL,TKNCHN)
  531.         ELSE
  532.            CALL ERROR('DOTRM: Statement 126 a DO.')
  533.         END IF
  534.         CALL ZTOKWR(TZEOS,0,DUMMY,TKNCHN)
  535.  
  536.         END
  537. C--------   GETSTR.MAC
  538.         SUBROUTINE GETSTR(NODE,STRING)
  539. C Get the string associated with a leaf node.
  540.  
  541.       INTEGER NODE,STRING(*)
  542.  
  543.         COMMON/IO/ IODTKN,IODCMI,IODCMT,IODTKO,IODCMO,TKNCHN
  544.         INTEGER IODTKN,IODCMI,IODCMT,IODTKO,IODCMO,TKNCHN
  545.       SAVE
  546.       INTEGER SYMVAL(8),POINTR,TYPE
  547.  
  548.       INTEGER ZYDOWN,ZYNTYP
  549.         EXTERNAL ERROR,ZYGTSY,ZYGTST,ZYDOWN,ZYNTYP
  550.  
  551.       STRING(1) = 129
  552.       POINTR = ZYDOWN(NODE)
  553. C Node is not a leaf:
  554.       IF (POINTR .GT. 0) CALL ERROR('GETSTR: Node Is Not a Leaf.')
  555. C Node is an unnamed leaf:
  556.       IF (POINTR .EQ. 0) RETURN
  557. C Node is a named leaf:
  558.       TYPE = ZYNTYP(NODE)
  559.       IF(TYPE .EQ. 108 .OR. TYPE .EQ. 40
  560.      +     .OR. TYPE .EQ. 115 .OR. TYPE .EQ. 116) THEN
  561.          CALL ZYGTSY(-POINTR,SYMVAL)
  562.          CALL ZYGTST(SYMVAL(2),STRING)
  563.       ELSE
  564.          CALL ZYGTST(-POINTR,STRING)
  565.       END IF
  566.  
  567.       RETURN
  568.       END
  569. C--------   IFLAB.MAC
  570. C ----------------------------------------------------------------------
  571. C
  572. C         I F L A B   -   Output an IF statement, making the following
  573. C                    transformation:
  574. C
  575. C                    If the IF is a logical IF and the object statement
  576. C                    is a GO TO, replace the label on the GO TO. If
  577. C                    the IF is an arithmetic IF, replace the three
  578. C                    object labels.
  579. C
  580.  
  581.         SUBROUTINE IFLAB(NODE,TKNCHN)
  582.         INTEGER NODE,TKNCHN
  583.  
  584.       COMMON/LABLST/OLDLBS,NEWLBS,NRLBS
  585.       INTEGER OLDLBS(6,200),NEWLBS(6,200),NRLBS
  586.  
  587.         INTEGER STYPE,PTR,DUMMY(2),LABLN(6),TYPE,SYMVAL(8)
  588.       LOGICAL FOUND
  589.  
  590. C---------------------------------------------------------
  591. C    TOOLPACK/1    Release: 2.1
  592. C---------------------------------------------------------
  593. C
  594. C  TKLAST = LAST TOKEN NUMBER
  595. C
  596.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  597.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  598.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  599.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  600.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  601.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  602.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  603.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  604.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  605.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  606.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  607.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  608.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  609.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  610.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  611.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  612.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  613.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  614.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  615.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  616.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  617.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  618.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  619.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  620.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  621.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  622.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  623.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  624.  
  625.  
  626.         SAVE
  627.  
  628.         INTEGER ZYNTYP,ZYDOWN,ZYNEXT,LENGTH
  629.         EXTERNAL ZYNTYP,ZYDOWN,ZYNEXT,ZTOKWR,YLEAF,LENGTH,
  630.      +           GETLAB,ZYGTSY,ZYGTST,XIFLAB,YEXPR,YSTMT,ERROR
  631.  
  632.         DATA DUMMY(1)/129/
  633.  
  634.         PTR=NODE
  635.         STYPE=ZYNTYP(PTR)
  636.         PTR=ZYDOWN(PTR)
  637.         IF (PTR.NE.0) THEN
  638.             IF (ZYNTYP(PTR).EQ.115) THEN
  639.                 CALL YLEAF(PTR,TKNCHN)
  640.                 PTR=ZYNEXT(PTR)
  641.             END IF
  642.         END IF
  643.         IF (STYPE.EQ.57 .OR. STYPE.EQ.55 .OR.
  644.      +           STYPE.EQ.58) THEN
  645.             CALL XIFLAB(PTR,TKNCHN)
  646.             CALL ZTOKWR(TZEOS,0,DUMMY,TKNCHN)
  647.         ELSE IF (STYPE.EQ.56) THEN
  648.             CALL ZTOKWR(TIF,0,DUMMY,TKNCHN)
  649.             CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  650.             CALL YEXPR(PTR,TKNCHN)
  651.             CALL ZTOKWR(TRPARN,0,DUMMY,TKNCHN)
  652.             PTR=ZYNEXT(PTR)
  653.           TYPE = ZYNTYP(PTR)
  654.           IF (TYPE .EQ. 51) THEN
  655.              CALL GETLAB(ZYDOWN(PTR),LABLN,FOUND)
  656.              IF (.NOT. FOUND) THEN
  657. C Transfer is out of DO loop, output same label.
  658.                 CALL ZYGTSY(-ZYDOWN(ZYDOWN(PTR)),SYMVAL)
  659.                   CALL ZYGTST(SYMVAL(2),LABLN)
  660.              END IF
  661.                CALL ZTOKWR(TGOTO,0,DUMMY,TKNCHN)
  662.              CALL ZTOKWR(TDCNST,LENGTH(LABLN),LABLN,TKNCHN)
  663.                CALL ZTOKWR(TZEOS,0,DUMMY,TKNCHN)
  664.           ELSE
  665.              CALL YSTMT(PTR,TKNCHN)
  666.           END IF
  667.         ELSE
  668.             CALL ERROR('UIF: Don''t understand statement type.')
  669.         END IF
  670.  
  671.         END
  672. C--------   NOPARN.MAC
  673. C---------------------------------------------------------------------
  674.         LOGICAL FUNCTION NOPARN(NODE)
  675. C Return .TRUE. or .FALSE. according to whether the string associated
  676. C with the named leaf node NODE need not be parenthesized because certain
  677. C sufficient conditions guaranteeing this conclusion hold.
  678.  
  679.       INTEGER NODE
  680.  
  681.         COMMON/IO/ IODTKN,IODCMI,IODCMT,IODTKO,IODCMO,TKNCHN
  682.         INTEGER IODTKN,IODCMI,IODCMT,IODTKO,IODCMO,TKNCHN
  683.       SAVE
  684.       INTEGER TYPEUP,PREVND
  685.  
  686.       INTEGER ZYDOWN,ZYNTYP,ZYUP,ZYPREV
  687.         EXTERNAL ERROR,ZYDOWN,ZYNTYP,ZYUP,ZYPREV
  688.  
  689.       NOPARN = .FALSE.
  690.  
  691.       IF (ZYDOWN(NODE) .GE. 0) CALL ERROR('NOPARN: Node Is Not '
  692.      +                     //'a Named Leaf.')
  693. C Node is a named leaf.
  694.  
  695.       TYPEUP = ZYNTYP(ZYUP(NODE))
  696.       PREVND = ZYPREV(NODE)
  697.  
  698. C Name is already parenthesized.
  699.       IF (TYPEUP .EQ. 101) THEN
  700.          NOPARN = .TRUE.
  701.          RETURN
  702.       END IF
  703.  
  704. C Name is an unsigned index of an array element.
  705.       IF (PREVND .NE. 0) THEN
  706.          IF ((ZYNTYP(PREVND) .NE. 115)
  707.      +         .AND. (TYPEUP .EQ. 104)) THEN
  708.             NOPARN = .TRUE.
  709.             RETURN
  710.          END IF
  711.       END IF
  712.  
  713.       END
  714. C--------   POP.MAC
  715. C ********************************************************************
  716.       INTEGER FUNCTION POP(STACK)
  717. C Pop an item from the stack.  STACK must have been initialized to
  718. C have STACK(1) = err.
  719.  
  720.       INTEGER STACK(500),I
  721.  
  722. C Return the item at the top of the stack.  If the stack is empty,
  723. C err is returned.
  724.       POP = STACK(1)
  725.  
  726. C Pop the stack.
  727.       DO 10 I=1,500
  728.          IF(STACK(I) .EQ. -1) GO TO 20
  729.          STACK(I) = STACK(I+1)
  730. 10      CONTINUE
  731.  
  732.    20 CONTINUE
  733.       END
  734. C--------   PUSH.MAC
  735. C ********************************************************************
  736.       INTEGER FUNCTION PUSH(ITEM,STACK)
  737. C Push an item onto the stack.  STACK must have been initialized to
  738. C have STACK(1) = err.
  739.  
  740.       INTEGER ITEM,STACK(500),I,J
  741.  
  742. C Find the end of the stack.
  743.       DO 10 I=1,500-1
  744.          IF(STACK(I) .EQ. -1) GO TO 20
  745. 10      CONTINUE
  746. C If the stack is full, return err.
  747.       PUSH = -1
  748.       RETURN
  749.  
  750. C Push down the stack and insert item at the top.
  751. 20      CONTINUE
  752.       DO 30 J=I,1,-1
  753.          STACK(J+1) = STACK(J)
  754. 30      CONTINUE
  755.  
  756.       STACK(1) = ITEM
  757.       PUSH = -2
  758.  
  759.       END
  760. C--------   UASGN.MAC
  761. C ----------------------------------------------------------------------
  762. C
  763. C         U A S G N   -   Output an assignment statement in which NAME
  764. C                    appears so that each occurrence of NAME is
  765. C                    replaced by (REPNAM + ICON*(E3)) where E3 is
  766. C                    an expression rooted at INCNOD.  If INCNOD=0,
  767. C                    then *(E3) is omitted.  If INCNOD = -1, then
  768. C                    NAME is replaced by REPNAM - ICON
  769.  
  770.         SUBROUTINE UASGN(NODE,NAME,REPNAM,ICON,INCNOD,TKNCHN)
  771.         INTEGER NODE,NAME(*),REPNAM(*),ICON(*),INCNOD,TKNCHN
  772.  
  773.         INTEGER STYPE,PTR,DUMMY(2)
  774.  
  775. C---------------------------------------------------------
  776. C    TOOLPACK/1    Release: 2.1
  777. C---------------------------------------------------------
  778. C
  779. C  TKLAST = LAST TOKEN NUMBER
  780. C
  781.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  782.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  783.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  784.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  785.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  786.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  787.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  788.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  789.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  790.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  791.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  792.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  793.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  794.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  795.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  796.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  797.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  798.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  799.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  800.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  801.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  802.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  803.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  804.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  805.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  806.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  807.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  808.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  809.  
  810.  
  811.         INTEGER ZYNTYP,ZYDOWN,ZYNEXT
  812.         EXTERNAL ZYNTYP,ZYDOWN,ZYNEXT,ZTOKWR,YLEAF,XNASGN,ERROR
  813.  
  814.         DATA DUMMY(1)/129/
  815.  
  816.         PTR=NODE
  817.         STYPE=ZYNTYP(PTR)
  818.         PTR=ZYDOWN(PTR)
  819.         IF (PTR.NE.0) THEN
  820.             IF (ZYNTYP(PTR).EQ.115) THEN
  821.                 CALL YLEAF(PTR,TKNCHN)
  822.                 PTR=ZYNEXT(PTR)
  823.             END IF
  824.         END IF
  825.       IF (STYPE .EQ. 49) THEN
  826.             CALL XNASGN(PTR,NAME,REPNAM,ICON,INCNOD,TKNCHN)
  827.         ELSE
  828.             CALL ERROR('UASGN: Not an assignment statement.')
  829.         END IF
  830.         CALL ZTOKWR(TZEOS,0,DUMMY,TKNCHN)
  831.  
  832.         END
  833. C--------   UASGU.MAC
  834. C ----------------------------------------------------------------------
  835. C
  836. C         U A S G U   -   Output an assignment statement in which NAME
  837. C                    appears so that each occurrence of NAME is
  838. C                    replaced by (NAME + ICON*(E3)) where E3 is
  839. C                    an expression rooted at INCNOD.  If INCNOD=0,
  840. C                    then E3=1 and *(E3) is omitted.  If INCNOD=-1
  841. C                    then NAME is replaced by NAME - ICON.
  842.  
  843.         SUBROUTINE UASGU(NODE,NAME,ICON,INCNOD,TKNCHN)
  844.         INTEGER NODE,NAME(*),ICON(*),INCNOD,TKNCHN
  845.  
  846.         INTEGER STYPE,PTR,DUMMY(2)
  847.  
  848. C---------------------------------------------------------
  849. C    TOOLPACK/1    Release: 2.1
  850. C---------------------------------------------------------
  851. C
  852. C  TKLAST = LAST TOKEN NUMBER
  853. C
  854.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  855.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  856.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  857.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  858.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  859.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  860.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  861.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  862.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  863.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  864.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  865.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  866.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  867.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  868.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  869.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  870.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  871.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  872.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  873.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  874.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  875.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  876.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  877.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  878.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  879.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  880.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  881.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  882.  
  883.  
  884.         INTEGER ZYNTYP,ZYDOWN,ZYNEXT
  885.         EXTERNAL ZYNTYP,ZYDOWN,ZYNEXT,ZTOKWR,YLEAF,XNASGU,ERROR
  886.  
  887.         DATA DUMMY(1)/129/
  888.  
  889.         PTR=NODE
  890.         STYPE=ZYNTYP(PTR)
  891.         PTR=ZYDOWN(PTR)
  892.         IF (PTR.NE.0) THEN
  893.             IF (ZYNTYP(PTR).EQ.115) THEN
  894.                 CALL YLEAF(PTR,TKNCHN)
  895.                 PTR=ZYNEXT(PTR)
  896.             END IF
  897.         END IF
  898.       IF (STYPE .EQ. 49) THEN
  899.             CALL XNASGU(PTR,NAME,ICON,INCNOD,TKNCHN)
  900.         ELSE
  901.             CALL ERROR('UASGU: Not an assignment statement.')
  902.         END IF
  903.         CALL ZTOKWR(TZEOS,0,DUMMY,TKNCHN)
  904.  
  905.         END
  906. C--------   UDO.MAC
  907. C ----------------------------------------------------------------------
  908. C            U D O    -   Output a DO statement in which NAME
  909. C                    appears in the DO specification so
  910. C                    that each occurrence of NAME is
  911. C                    replaced by (NAME + ICON*(E3)) where E3 is
  912. C                    an expression rooted at INCNOD.  If INCNOD=0,
  913. C                    then E3=1 and *(E3) is omitted.  If INCNOD=-1
  914. C                    then NAME is replaced by NAME - ICON.
  915. C                    Also the termination label is to be TRMLBL.
  916.  
  917.         SUBROUTINE UDO(NODE,NAME,ICON,INCNOD,TRMLBL,TKNCHN)
  918.         INTEGER NODE,NAME(*),ICON(*),INCNOD,TRMLBL(*),TKNCHN
  919.  
  920.         INTEGER STYPE,PTR,DUMMY(2)
  921.  
  922. C---------------------------------------------------------
  923. C    TOOLPACK/1    Release: 2.1
  924. C---------------------------------------------------------
  925. C
  926. C  TKLAST = LAST TOKEN NUMBER
  927. C
  928.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  929.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  930.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  931.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  932.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  933.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  934.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  935.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  936.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  937.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  938.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  939.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  940.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  941.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  942.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  943.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  944.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  945.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  946.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  947.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  948.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  949.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  950.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  951.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  952.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  953.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  954.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  955.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  956.  
  957.  
  958.         INTEGER ZYNTYP,ZYDOWN,ZYNEXT
  959.         EXTERNAL ZYNTYP,ZYDOWN,ZYNEXT,ZTOKWR,YLEAF,XYUDO,ERROR
  960.  
  961.         DATA DUMMY(1)/129/
  962.  
  963.         PTR=NODE
  964.         STYPE=ZYNTYP(PTR)
  965.         PTR=ZYDOWN(PTR)
  966.         IF (PTR.NE.0) THEN
  967.             IF (ZYNTYP(PTR).EQ.115) THEN
  968.                 CALL YLEAF(PTR,TKNCHN)
  969.                 PTR=ZYNEXT(PTR)
  970.             END IF
  971.         END IF
  972.       IF (STYPE .EQ. 61) THEN
  973.            CALL XYUDO(PTR,NAME,ICON,INCNOD,TRMLBL,TKNCHN)
  974.         ELSE
  975.             CALL ERROR('UDO: Statement 126 a DO.')
  976.         END IF
  977.         CALL ZTOKWR(TZEOS,0,DUMMY,TKNCHN)
  978.  
  979.         END
  980. C--------   UDOSP.MAC
  981. C ----------------------------------------------------------------------
  982. C
  983. C         U D O S P   -   Output a DO specification in which NAME appears
  984. C                    so that each occurrence of NAME is
  985. C                    replaced by (NAME + ICON*(E3)) where E3 is
  986. C                    an expression rooted at INCNOD.  If INCNOD=0,
  987. C                    then E3=1 and *(E3) is omitted.  If INCNOD=-1,
  988. C                    then NAME is replaced by NAME - ICON.
  989. C
  990.  
  991.         SUBROUTINE UDOSP(NODE,NAME,ICON,INCNOD,TKNCHN)
  992.         INTEGER NODE,NAME(*),ICON(*),INCNOD,TKNCHN
  993.  
  994.         INTEGER PTR,DUMMY(2)
  995.  
  996. C---------------------------------------------------------
  997. C    TOOLPACK/1    Release: 2.1
  998. C---------------------------------------------------------
  999. C
  1000. C  TKLAST = LAST TOKEN NUMBER
  1001. C
  1002.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1003.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1004.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1005.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1006.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1007.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1008.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1009.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1010.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1011.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1012.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1013.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1014.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1015.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1016.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1017.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1018.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1019.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1020.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1021.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1022.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1023.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1024.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1025.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1026.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1027.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1028.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1029.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1030.  
  1031.  
  1032.         INTEGER ZYNEXT,ZYDOWN
  1033.         EXTERNAL ZYNEXT,ZYDOWN,ZTOKWR,YLEAF,YEXPRU
  1034.  
  1035.         DATA DUMMY(1)/129/
  1036.  
  1037.         PTR=ZYDOWN(NODE)
  1038.         CALL YLEAF(PTR,TKNCHN)
  1039.         CALL ZTOKWR(TEQUAL,0,DUMMY,TKNCHN)
  1040.         PTR=ZYNEXT(PTR)
  1041.         CALL YEXPRU(PTR,NAME,ICON,INCNOD,TKNCHN)
  1042.         PTR=ZYNEXT(PTR)
  1043.         CALL ZTOKWR(TCOMMA,0,DUMMY,TKNCHN)
  1044.         CALL YEXPRU(PTR,NAME,ICON,INCNOD,TKNCHN)
  1045.         PTR=ZYNEXT(PTR)
  1046.         IF (PTR.NE.0) THEN
  1047.             CALL ZTOKWR(TCOMMA,0,DUMMY,TKNCHN)
  1048.             CALL YEXPRU(PTR,NAME,ICON,INCNOD,TKNCHN)
  1049.         END IF
  1050.  
  1051.         END
  1052. C--------   UIF.MAC
  1053. C ----------------------------------------------------------------------
  1054. C
  1055. C         U I F     -     Output an IF statement in which NAME
  1056. C                    appears so that each occurrence of NAME is
  1057. C                    replaced by (NAME + ICON*(E3)) where E3 is
  1058. C                    an expression rooted at INCNOD.  If INCNOD=0,
  1059. C                    then E3=1 and *(E3) is omitted.
  1060. C                    If the IF object statement is a GO TO, replace
  1061. C                    the label reference.
  1062. C
  1063.  
  1064.         SUBROUTINE UIF(NODE,NAME,ICON,INCNOD,TKNCHN)
  1065.         INTEGER NODE,NAME(*),ICON(*),INCNOD,TKNCHN
  1066.  
  1067.       COMMON/LABLST/OLDLBS,NEWLBS,NRLBS
  1068.       INTEGER OLDLBS(6,200),NEWLBS(6,200),NRLBS
  1069.  
  1070.         INTEGER STYPE,PTR,DUMMY(2),LABLN(6),TYPE,SYMVAL(8)
  1071.       LOGICAL FOUND
  1072.  
  1073. C---------------------------------------------------------
  1074. C    TOOLPACK/1    Release: 2.1
  1075. C---------------------------------------------------------
  1076. C
  1077. C  TKLAST = LAST TOKEN NUMBER
  1078. C
  1079.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1080.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1081.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1082.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1083.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1084.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1085.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1086.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1087.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1088.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1089.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1090.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1091.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1092.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1093.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1094.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1095.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1096.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1097.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1098.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1099.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1100.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1101.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1102.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1103.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1104.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1105.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1106.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1107.  
  1108.  
  1109.         SAVE
  1110.  
  1111.         INTEGER ZYNTYP,ZYDOWN,ZYNEXT,LENGTH,NAMEP
  1112.         EXTERNAL ZYNTYP,ZYDOWN,ZYNEXT,ZTOKWR,YLEAF,LENGTH,GETLAB,
  1113.      +           ZYGTSY,ZYGTST,NAMEP,XYUIF,YEXPRU,UASGU,YSTMT,ERROR
  1114.  
  1115.         DATA DUMMY(1)/129/
  1116.  
  1117.         PTR=NODE
  1118.         STYPE=ZYNTYP(PTR)
  1119.         PTR=ZYDOWN(PTR)
  1120.         IF (PTR.NE.0) THEN
  1121.             IF (ZYNTYP(PTR).EQ.115) THEN
  1122.                 CALL YLEAF(PTR,TKNCHN)
  1123.                 PTR=ZYNEXT(PTR)
  1124.             END IF
  1125.         END IF
  1126.         IF (STYPE.EQ.57 .OR. STYPE.EQ.55 .OR.
  1127.      +           STYPE.EQ.58) THEN
  1128.             CALL XYUIF(PTR,NAME,ICON,INCNOD,TKNCHN)
  1129.             CALL ZTOKWR(TZEOS,0,DUMMY,TKNCHN)
  1130.         ELSE IF (STYPE.EQ.56) THEN
  1131.             CALL ZTOKWR(TIF,0,DUMMY,TKNCHN)
  1132.             CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  1133.             CALL YEXPRU(PTR,NAME,ICON,INCNOD,TKNCHN)
  1134.             CALL ZTOKWR(TRPARN,0,DUMMY,TKNCHN)
  1135.             PTR=ZYNEXT(PTR)
  1136.           TYPE = ZYNTYP(PTR)
  1137.           IF (TYPE .EQ. 51) THEN
  1138.              CALL GETLAB(ZYDOWN(PTR),LABLN,FOUND)
  1139.              IF (.NOT. FOUND) THEN
  1140. C Transfer is out of DO loop, output same label.
  1141.                 CALL ZYGTSY(-ZYDOWN(ZYDOWN(PTR)),SYMVAL)
  1142.                   CALL ZYGTST(SYMVAL(2),LABLN)
  1143.              END IF
  1144.                CALL ZTOKWR(TGOTO,0,DUMMY,TKNCHN)
  1145.              CALL ZTOKWR(TDCNST,LENGTH(LABLN),LABLN,TKNCHN)
  1146.                CALL ZTOKWR(TZEOS,0,DUMMY,TKNCHN)
  1147.           ELSE IF (TYPE .EQ. 49 .AND. NAMEP(PTR,NAME) .EQ. -2)
  1148.      +               THEN
  1149.              CALL UASGU(PTR,NAME,ICON,INCNOD,TKNCHN)
  1150.           ELSE
  1151.              CALL YSTMT(PTR,TKNCHN)
  1152.           END IF
  1153.         ELSE
  1154.             CALL ERROR('UIF: Don''t understand statement type.')
  1155.         END IF
  1156.  
  1157.         END
  1158. C--------   XDOTRM.MAC
  1159. C ----------------------------------------------------------------------
  1160. C
  1161. C       X D O T R M  -  Output a DO statement as specified in DOTRM.
  1162. C
  1163. C
  1164.  
  1165.       SUBROUTINE XDOTRM(NODE,TRMLBL,TKNCHN)
  1166.       INTEGER NODE,TRMLBL(*),TKNCHN
  1167.  
  1168. C---------------------------------------------------------
  1169. C    TOOLPACK/1    Release: 2.1
  1170. C---------------------------------------------------------
  1171. C
  1172. C  TKLAST = LAST TOKEN NUMBER
  1173. C
  1174.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1175.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1176.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1177.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1178.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1179.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1180.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1181.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1182.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1183.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1184.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1185.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1186.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1187.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1188.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1189.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1190.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1191.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1192.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1193.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1194.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1195.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1196.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1197.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1198.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1199.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1200.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1201.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1202.  
  1203.  
  1204.       INTEGER ZYNEXT,LENGTH
  1205.       EXTERNAL ZYNEXT,ZTOKWR,LENGTH,XYDOSP
  1206.  
  1207.       CALL ZTOKWR(TDO,0,TRMLBL,TKNCHN)
  1208.       CALL ZTOKWR(TDCNST,LENGTH(TRMLBL),TRMLBL,TKNCHN)
  1209.       CALL XYDOSP(ZYNEXT(NODE),TKNCHN)
  1210.  
  1211.       END
  1212. C--------   XIFLAB.MAC
  1213. C ----------------------------------------------------------------------
  1214. C
  1215. C       X I F L A B  -  Handles all IF/ELSEIF statements except logical IF
  1216. C                  as specified in IFLAB.
  1217.  
  1218.         SUBROUTINE XIFLAB(NODE,TKNCHN)
  1219.         INTEGER NODE,TKNCHN
  1220.  
  1221.       COMMON/LABLST/OLDLBS,NEWLBS,NRLBS
  1222.       INTEGER OLDLBS(6,200),NEWLBS(6,200),NRLBS
  1223.  
  1224. C---------------------------------------------------------
  1225. C    TOOLPACK/1    Release: 2.1
  1226. C---------------------------------------------------------
  1227. C
  1228. C  TKLAST = LAST TOKEN NUMBER
  1229. C
  1230.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1231.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1232.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1233.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1234.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1235.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1236.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1237.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1238.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1239.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1240.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1241.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1242.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1243.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1244.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1245.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1246.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1247.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1248.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1249.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1250.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1251.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1252.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1253.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1254.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1255.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1256.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1257.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1258.  
  1259.  
  1260.         INTEGER DUMMY(2),NTYPE,REFNOD,LABLN(6)
  1261.       LOGICAL FOUND
  1262.  
  1263.         SAVE
  1264.  
  1265.         INTEGER ZYNEXT,ZYNTYP,ZYUP,LENGTH
  1266.         EXTERNAL ZYNEXT,ZYNTYP,ZYUP,ZTOKWR,GETLAB,LENGTH,YEXPR,ERROR
  1267.  
  1268.         DATA DUMMY(1)/129/
  1269.  
  1270.         NTYPE=ZYNTYP(ZYUP(NODE))
  1271.         IF (NTYPE.EQ.58) THEN
  1272.             CALL ZTOKWR(TELSIF,0,DUMMY,TKNCHN)
  1273.         ELSE
  1274.             CALL ZTOKWR(TIF,0,DUMMY,TKNCHN)
  1275.         END IF
  1276.         CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  1277.         CALL YEXPR(NODE,TKNCHN)
  1278.         CALL ZTOKWR(TRPARN,0,DUMMY,TKNCHN)
  1279.         IF (NTYPE.EQ.55) THEN
  1280. C Replace the three labels.
  1281.           REFNOD = ZYNEXT(NODE)
  1282.           CALL GETLAB(REFNOD,LABLN,FOUND)
  1283.           IF (.NOT. FOUND) THEN
  1284.             CALL ZMESS('XIFLAB: First Label Reference Not Found.',2)
  1285.             CALL PUTLIN(LABLN, 2)
  1286.             CALL ZMESS(':refers to do loop termination statement?.',2)
  1287.             CALL ZQUIT(-1)
  1288.           ENDIF
  1289.           CALL ZTOKWR(TDCNST,LENGTH(LABLN),LABLN,TKNCHN)
  1290.             CALL ZTOKWR(TCOMMA,0,DUMMY,TKNCHN)
  1291.           REFNOD = ZYNEXT(REFNOD)
  1292.           CALL GETLAB(REFNOD,LABLN,FOUND)
  1293.           IF (.NOT. FOUND) THEN
  1294.             CALL ZMESS('XIFLAB: Second Label Reference Not Found.',2)
  1295.             CALL PUTLIN(LABLN, 2)
  1296.             CALL ZMESS(':refers to do loop termination statement?.',2)
  1297.             CALL ZQUIT(-1)
  1298.           ENDIF
  1299.           CALL ZTOKWR(TDCNST,LENGTH(LABLN),LABLN,TKNCHN)
  1300.             CALL ZTOKWR(TCOMMA,0,DUMMY,TKNCHN)
  1301.           REFNOD = ZYNEXT(REFNOD)
  1302.           CALL GETLAB(REFNOD,LABLN,FOUND)
  1303.           IF (.NOT. FOUND) THEN
  1304.             CALL ZMESS('XIFLAB: Third Label Reference Not Found.',2)
  1305.             CALL PUTLIN(LABLN, 2)
  1306.             CALL ZMESS(':refers to do loop termination statement?.',2)
  1307.             CALL ZQUIT(-1)
  1308.           ENDIF
  1309.           CALL ZTOKWR(TDCNST,LENGTH(LABLN),LABLN,TKNCHN)
  1310.         ELSE
  1311.             CALL ZTOKWR(TTHEN,0,DUMMY,TKNCHN)
  1312.         END IF
  1313.  
  1314.         END
  1315. C--------   XNASGN.MAC
  1316. C ----------------------------------------------------------------------
  1317. C
  1318. C       X N A S G N   -   Output an assignment statement
  1319. C
  1320.  
  1321.       SUBROUTINE XNASGN(NODE,NAME,REPNAM,ICON,INCNOD,TKNCHN)
  1322.       INTEGER NODE,NAME(*),REPNAM(*),ICON(*),INCNOD,TKNCHN
  1323.  
  1324.       INTEGER DUMMY(2)
  1325.  
  1326. C---------------------------------------------------------
  1327. C    TOOLPACK/1    Release: 2.1
  1328. C---------------------------------------------------------
  1329. C
  1330. C  TKLAST = LAST TOKEN NUMBER
  1331. C
  1332.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1333.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1334.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1335.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1336.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1337.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1338.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1339.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1340.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1341.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1342.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1343.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1344.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1345.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1346.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1347.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1348.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1349.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1350.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1351.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1352.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1353.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1354.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1355.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1356.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1357.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1358.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1359.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1360.  
  1361.  
  1362.       INTEGER ZYNEXT
  1363.       EXTERNAL ZYNEXT,ZTOKWR,YITEMN,YEXPRN
  1364.  
  1365.       CALL YITEMN(NODE,NAME,REPNAM,ICON,INCNOD,TKNCHN)
  1366.       CALL ZTOKWR(TEQUAL,0,DUMMY,TKNCHN)
  1367.       CALL YEXPRN(ZYNEXT(NODE),NAME,REPNAM,ICON,INCNOD,TKNCHN)
  1368.  
  1369.       END
  1370. C--------   XNASGU.MAC
  1371. C ----------------------------------------------------------------------
  1372. C
  1373. C       X N A S G U   -   Output an assignment statement
  1374. C
  1375.  
  1376.       SUBROUTINE XNASGU(NODE,NAME,ICON,INCNOD,TKNCHN)
  1377.       INTEGER NODE,NAME(*),ICON(*),INCNOD,TKNCHN
  1378.  
  1379.       INTEGER DUMMY(2)
  1380.  
  1381. C---------------------------------------------------------
  1382. C    TOOLPACK/1    Release: 2.1
  1383. C---------------------------------------------------------
  1384. C
  1385. C  TKLAST = LAST TOKEN NUMBER
  1386. C
  1387.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1388.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1389.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1390.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1391.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1392.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1393.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1394.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1395.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1396.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1397.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1398.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1399.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1400.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1401.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1402.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1403.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1404.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1405.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1406.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1407.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1408.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1409.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1410.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1411.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1412.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1413.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1414.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1415.  
  1416.  
  1417.       INTEGER ZYNEXT
  1418.       EXTERNAL ZYNEXT,ZTOKWR,YITEMU,YEXPRU
  1419.  
  1420.       CALL YITEMU(NODE,NAME,ICON,INCNOD,TKNCHN)
  1421.       CALL ZTOKWR(TEQUAL,0,DUMMY,TKNCHN)
  1422.       CALL YEXPRU(ZYNEXT(NODE),NAME,ICON,INCNOD,TKNCHN)
  1423.  
  1424.       END
  1425. C--------   XSASGN.MAC
  1426. C ----------------------------------------------------------------------
  1427. C
  1428. C       X S A S G N   -   Output an assignment statement
  1429. C
  1430.  
  1431.       SUBROUTINE XSASGN(NODE,REDNOD,SUBNOD,TKNCHN)
  1432.       INTEGER NODE,REDNOD,SUBNOD,TKNCHN
  1433.  
  1434.       INTEGER DUMMY(2)
  1435.  
  1436. C---------------------------------------------------------
  1437. C    TOOLPACK/1    Release: 2.1
  1438. C---------------------------------------------------------
  1439. C
  1440. C  TKLAST = LAST TOKEN NUMBER
  1441. C
  1442.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1443.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1444.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1445.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1446.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1447.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1448.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1449.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1450.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1451.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1452.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1453.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1454.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1455.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1456.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1457.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1458.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1459.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1460.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1461.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1462.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1463.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1464.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1465.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1466.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1467.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1468.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1469.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1470.  
  1471.  
  1472.       INTEGER ZYNEXT
  1473.       EXTERNAL ZYNEXT,ZTOKWR,YITEM,YEXPR
  1474.  
  1475.       CALL YITEMS(NODE,REDNOD,SUBNOD,TKNCHN)
  1476.       CALL ZTOKWR(TEQUAL,0,DUMMY,TKNCHN)
  1477.       CALL YEXPRS(ZYNEXT(NODE),REDNOD,SUBNOD,TKNCHN)
  1478.  
  1479.       END
  1480. C--------   XYUDO.MAC
  1481. C ----------------------------------------------------------------------
  1482. C
  1483. C       X Y U D O   -   Output a DO statement as specified in UDO.
  1484. C
  1485. C
  1486.  
  1487.       SUBROUTINE XYUDO(NODE,NAME,ICON,INCNOD,TRMLBL,TKNCHN)
  1488.       INTEGER NODE,NAME(*),ICON(*),INCNOD,TRMLBL(*),TKNCHN
  1489.  
  1490. C---------------------------------------------------------
  1491. C    TOOLPACK/1    Release: 2.1
  1492. C---------------------------------------------------------
  1493. C
  1494. C  TKLAST = LAST TOKEN NUMBER
  1495. C
  1496.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1497.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1498.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1499.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1500.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1501.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1502.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1503.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1504.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1505.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1506.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1507.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1508.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1509.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1510.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1511.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1512.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1513.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1514.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1515.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1516.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1517.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1518.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1519.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1520.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1521.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1522.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1523.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1524.  
  1525.  
  1526.       INTEGER ZYNEXT,LENGTH
  1527.       EXTERNAL ZYNEXT,ZTOKWR,LENGTH,UDOSP
  1528.  
  1529.       CALL ZTOKWR(TDO,0,TRMLBL,TKNCHN)
  1530.       CALL ZTOKWR(TDCNST,LENGTH(TRMLBL),TRMLBL,TKNCHN)
  1531.       CALL UDOSP(ZYNEXT(NODE),NAME,ICON,INCNOD,TKNCHN)
  1532.  
  1533.       END
  1534. C--------   XYUIF.MAC
  1535. C ----------------------------------------------------------------------
  1536. C
  1537. C   X Y U I F   -   Handles all IF/ELSEIF statements except logical IF
  1538. C                   as specified in UIF.
  1539.  
  1540.       SUBROUTINE XYUIF(NODE,NAME,ICON,INCNOD,TKNCHN)
  1541.       INTEGER NODE,NAME(*),ICON(*),INCNOD,TKNCHN
  1542.  
  1543.       COMMON/LABLST/OLDLBS,NEWLBS,NRLBS
  1544.       INTEGER OLDLBS(6,200),NEWLBS(6,200),NRLBS
  1545.  
  1546. C---------------------------------------------------------
  1547. C    TOOLPACK/1    Release: 2.1
  1548. C---------------------------------------------------------
  1549. C
  1550. C  TKLAST = LAST TOKEN NUMBER
  1551. C
  1552.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1553.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1554.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1555.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1556.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1557.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1558.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1559.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1560.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1561.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1562.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1563.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1564.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1565.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1566.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1567.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1568.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1569.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1570.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1571.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1572.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1573.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1574.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1575.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1576.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1577.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1578.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1579.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1580.  
  1581.  
  1582.       INTEGER NTYPE,REFNOD,LABLN(6)
  1583.       LOGICAL FOUND
  1584.  
  1585.       SAVE
  1586.  
  1587.       INTEGER ZYNEXT,ZYNTYP,ZYUP,LENGTH
  1588.       EXTERNAL ZYNEXT,ZYNTYP,ZYUP,ZTOKWR,GETLAB,LENGTH,YEXPRU,ERROR,
  1589.      +         PUTLIN,ZCHOUT,ZMESS
  1590.  
  1591.       NTYPE=ZYNTYP(ZYUP(NODE))
  1592.       IF (NTYPE.EQ.58) THEN
  1593.         CALL ZTOKWR(TELSIF,0,LABLN,TKNCHN)
  1594.       ELSE
  1595.         CALL ZTOKWR(TIF,0,LABLN,TKNCHN)
  1596.       END IF
  1597.       CALL ZTOKWR(TLPARN,0,LABLN,TKNCHN)
  1598.       CALL YEXPRU(NODE,NAME,ICON,INCNOD,TKNCHN)
  1599.       CALL ZTOKWR(TRPARN,0,LABLN,TKNCHN)
  1600.  
  1601.       IF (NTYPE.EQ.55) THEN
  1602. C Replace the three labels.
  1603.         REFNOD = ZYNEXT(NODE)
  1604.         CALL GETLAB(REFNOD,LABLN,FOUND)
  1605.         IF (.NOT. FOUND) GO TO 999
  1606.         CALL ZTOKWR(TDCNST,LENGTH(LABLN),LABLN,TKNCHN)
  1607.         CALL ZTOKWR(TCOMMA,0,LABLN,TKNCHN)
  1608.  
  1609.         REFNOD = ZYNEXT(REFNOD)
  1610.         CALL GETLAB(REFNOD,LABLN,FOUND)
  1611.         IF (.NOT. FOUND) GO TO 999
  1612.         CALL ZTOKWR(TDCNST,LENGTH(LABLN),LABLN,TKNCHN)
  1613.         CALL ZTOKWR(TCOMMA,0,LABLN,TKNCHN)
  1614.  
  1615.         REFNOD = ZYNEXT(REFNOD)
  1616.         CALL GETLAB(REFNOD,LABLN,FOUND)
  1617.         IF (.NOT. FOUND) GO TO 999
  1618.         CALL ZTOKWR(TDCNST,LENGTH(LABLN),LABLN,TKNCHN)
  1619.  
  1620.       ELSE
  1621.         CALL ZTOKWR(TTHEN,0,LABLN,TKNCHN)
  1622.       END IF
  1623.       RETURN
  1624.  
  1625.   999 CONTINUE
  1626.       CALL ZCHOUT('Arithmetic IF: Label .', 1)
  1627.       CALL PUTLIN(LABLN, 1)
  1628.       CALL ZMESS(' 126 found...', 1)
  1629.       CALL ERROR('[Tool Aborting].')
  1630.  
  1631.       END
  1632. C--------   YAELMS.MAC
  1633. C ----------------------------------------------------------------------
  1634. C
  1635. C       Y A E L M S   -   Output token stream for an array_element_name
  1636. C
  1637.  
  1638.         SUBROUTINE YAELMS(NODE,REDNOD,SUBNOD,TKNCHN)
  1639.         INTEGER NODE,REDNOD,SUBNOD,TKNCHN
  1640.  
  1641. C---------------------------------------------------------
  1642. C    TOOLPACK/1    Release: 2.1
  1643. C---------------------------------------------------------
  1644. C
  1645. C  TKLAST = LAST TOKEN NUMBER
  1646. C
  1647.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1648.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1649.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1650.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1651.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1652.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1653.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1654.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1655.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1656.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1657.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1658.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1659.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1660.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1661.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1662.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1663.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1664.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1665.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1666.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1667.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1668.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1669.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1670.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1671.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1672.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1673.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1674.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1675.  
  1676.  
  1677.         INTEGER PTR,DUMMY(2)
  1678.  
  1679.         INTEGER ZYDOWN,ZYNEXT,LENGTH
  1680.         EXTERNAL ZYDOWN,ZYNEXT,LENGTH,ZTOKWR
  1681.  
  1682.         DATA DUMMY(1)/129/
  1683.  
  1684.         PTR=ZYDOWN(NODE)
  1685.         CALL YLEAF(PTR,TKNCHN)
  1686.         CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  1687.         PTR=ZYNEXT(PTR)
  1688.  
  1689. 100     CALL YEXPRS(PTR,REDNOD,SUBNOD,TKNCHN)
  1690.         PTR=ZYNEXT(PTR)
  1691.         IF (PTR.GT.0) THEN
  1692.             CALL ZTOKWR(TCOMMA,0,DUMMY,TKNCHN)
  1693.             GOTO 100
  1694.         END IF
  1695.         CALL ZTOKWR(TRPARN,0,DUMMY,TKNCHN)
  1696.  
  1697.         END
  1698. C--------   YEXPRN.MAC
  1699. C ----------------------------------------------------------------------
  1700. C
  1701. C       Y E X P R N  -   Output an expression
  1702. C
  1703.  
  1704.         SUBROUTINE YEXPRN(NODE,NAME,REPNAM,ICON,INCNOD,TKNCHN)
  1705.         INTEGER NODE,NAME(*),REPNAM(*),ICON(*),INCNOD,TKNCHN
  1706.  
  1707. C---------------------------------------------------------
  1708. C    TOOLPACK/1    Release: 2.1
  1709. C---------------------------------------------------------
  1710. C
  1711. C  TKLAST = LAST TOKEN NUMBER
  1712. C
  1713.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1714.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1715.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1716.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1717.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1718.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1719.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1720.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1721.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1722.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1723.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1724.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1725.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1726.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1727.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1728.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1729.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1730.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1731.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1732.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1733.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1734.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1735.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1736.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1737.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1738.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1739.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1740.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1741.  
  1742.  
  1743.         INTEGER PTR,DUMMY(2),UP,DOWN,NTYPE,NEXT,UPTYPE
  1744.  
  1745.         INTEGER ZYDOWN,ZYNEXT,ZYNTYP,ZYUP
  1746.         EXTERNAL ZYDOWN,ZYNEXT,ZYNTYP,ZTOKWR,ZYUP,YLEAFN
  1747.  
  1748.         DATA DUMMY(1)/129/
  1749.  
  1750.         PTR=NODE
  1751.  
  1752. C
  1753. C Going down
  1754. C
  1755.  100    DOWN=ZYDOWN(PTR)
  1756.         NTYPE=ZYNTYP(PTR)
  1757.         IF (DOWN.LE.0) THEN
  1758.             IF (NTYPE.NE.106)
  1759.      +         CALL YLEAFN(PTR,NAME,REPNAM,ICON,INCNOD,TKNCHN)
  1760.             GOTO 1000
  1761.         END IF
  1762.         IF (NTYPE.EQ.97) THEN
  1763.             CALL ZTOKWR(TPLUS,0,DUMMY,TKNCHN)
  1764.         ELSE IF (NTYPE.EQ.46) THEN
  1765.             CALL ZTOKWR(TMINUS,0,DUMMY,TKNCHN)
  1766.         ELSE IF (NTYPE.EQ.101 .OR. NTYPE.EQ.102) THEN
  1767.             CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  1768.         ELSE IF (NTYPE.EQ.88) THEN
  1769.             CALL ZTOKWR(TNOT,0,DUMMY,TKNCHN)
  1770.         END IF
  1771.         PTR=DOWN
  1772.         GOTO 100
  1773. C
  1774. C Going up (or next if this isn't the last)
  1775. C
  1776.  1000   IF (PTR.EQ.NODE) RETURN
  1777.         UP=ZYUP(PTR)
  1778.         UPTYPE=ZYNTYP(UP)
  1779.         IF (UPTYPE.EQ.101) THEN
  1780.             CALL ZTOKWR(TRPARN,0,DUMMY,TKNCHN)
  1781.             PTR=UP
  1782.             GOTO 1000
  1783.         ELSE IF (UPTYPE.EQ.97 .OR. UPTYPE.EQ.46 .OR.
  1784.      +           UPTYPE.EQ.88) THEN
  1785.             PTR=UP
  1786.             GOTO 1000
  1787.         END IF
  1788.         NEXT=ZYNEXT(PTR)
  1789.         IF (NEXT.EQ.0) THEN
  1790.             IF (UPTYPE.EQ.119 .OR. UPTYPE.EQ.104 .OR.
  1791.      +          UPTYPE.EQ.102 .OR. UPTYPE.EQ.105) THEN
  1792. C Check for special case of no list (N_FUNREF only)
  1793.                 IF (ZYDOWN(UP).EQ.PTR)
  1794.      +              CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  1795.                 CALL ZTOKWR(TRPARN,0,DUMMY,TKNCHN)
  1796.             END IF
  1797.             PTR=UP
  1798.             GOTO 1000
  1799.         END IF
  1800. C NEXT.NE.0
  1801.         IF (UPTYPE.EQ.95) THEN
  1802.             CALL ZTOKWR(TPLUS,0,DUMMY,TKNCHN)
  1803.         ELSE IF (UPTYPE.EQ.96) THEN
  1804.             CALL ZTOKWR(TMINUS,0,DUMMY,TKNCHN)
  1805.         ELSE IF (UPTYPE.EQ.98) THEN
  1806.             CALL ZTOKWR(TSTAR,0,DUMMY,TKNCHN)
  1807.         ELSE IF (UPTYPE.EQ.99) THEN
  1808.             CALL ZTOKWR(TSLASH,0,DUMMY,TKNCHN)
  1809.         ELSE IF (UPTYPE.EQ.100) THEN
  1810.             CALL ZTOKWR(TDSTAR,0,DUMMY,TKNCHN)
  1811.         ELSE IF (UPTYPE.EQ.102) THEN
  1812.             CALL ZTOKWR(TCOMMA,0,DUMMY,TKNCHN)
  1813.         ELSE IF (UPTYPE.EQ.84) THEN
  1814.             CALL ZTOKWR(TEQV,0,DUMMY,TKNCHN)
  1815.         ELSE IF (UPTYPE.EQ.85) THEN
  1816.             CALL ZTOKWR(TNEQV,0,DUMMY,TKNCHN)
  1817.         ELSE IF (UPTYPE.EQ.87) THEN
  1818.             CALL ZTOKWR(TAND,0,DUMMY,TKNCHN)
  1819.         ELSE IF (UPTYPE.EQ.86) THEN
  1820.             CALL ZTOKWR(TOR,0,DUMMY,TKNCHN)
  1821.         ELSE IF (UPTYPE.EQ.70) THEN
  1822.             CALL ZTOKWR(TCNCAT,0,DUMMY,TKNCHN)
  1823.         ELSE IF (UPTYPE.EQ.90) THEN
  1824.             CALL ZTOKWR(TLE,0,DUMMY,TKNCHN)
  1825.         ELSE IF (UPTYPE.EQ.89) THEN
  1826.             CALL ZTOKWR(TLT,0,DUMMY,TKNCHN)
  1827.         ELSE IF (UPTYPE.EQ.93) THEN
  1828.             CALL ZTOKWR(TGT,0,DUMMY,TKNCHN)
  1829.         ELSE IF (UPTYPE.EQ.94) THEN
  1830.             CALL ZTOKWR(TGE,0,DUMMY,TKNCHN)
  1831.         ELSE IF (UPTYPE.EQ.91) THEN
  1832.             CALL ZTOKWR(TEQ,0,DUMMY,TKNCHN)
  1833.         ELSE IF (UPTYPE.EQ.92) THEN
  1834.             CALL ZTOKWR(TNE,0,DUMMY,TKNCHN)
  1835.         ELSE IF (UPTYPE.EQ.105) THEN
  1836.             CALL ZTOKWR(TCOLON,0,DUMMY,TKNCHN)
  1837.         ELSE
  1838. C Must be N_ARELM or N_FUNREF or N_SUBSTR
  1839.             IF (ZYDOWN(UP).EQ.PTR) THEN
  1840.                 CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  1841.             ELSE
  1842.                 CALL ZTOKWR(TCOMMA,0,DUMMY,TKNCHN)
  1843.             END IF
  1844.         END IF
  1845.         PTR=NEXT
  1846.         GOTO 100
  1847.  
  1848.         END
  1849. C--------   YEXPRS.MAC
  1850. C ----------------------------------------------------------------------
  1851. C
  1852. C       Y E X P R S  -   Output an expression
  1853. C
  1854.  
  1855.         SUBROUTINE YEXPRS(NODE,REDNOD,SUBNOD,TKNCHN)
  1856.         INTEGER NODE,REDNOD,SUBNOD,TKNCHN
  1857.  
  1858. C---------------------------------------------------------
  1859. C    TOOLPACK/1    Release: 2.1
  1860. C---------------------------------------------------------
  1861. C
  1862. C  TKLAST = LAST TOKEN NUMBER
  1863. C
  1864.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1865.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1866.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1867.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1868.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1869.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1870.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1871.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1872.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1873.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1874.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1875.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1876.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1877.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1878.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1879.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1880.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1881.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1882.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1883.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1884.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1885.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1886.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1887.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1888.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1889.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1890.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1891.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1892.  
  1893.  
  1894.         INTEGER PTR,DUMMY(2),UP,DOWN,NTYPE,NEXT,UPTYPE
  1895.  
  1896.         INTEGER ZYDOWN,ZYNEXT,ZYNTYP,ZYUP,COMPAR
  1897.         EXTERNAL ZYDOWN,ZYNEXT,ZYNTYP,ZTOKWR,ZYUP,COMPAR
  1898.  
  1899.         DATA DUMMY(1)/129/
  1900.  
  1901.         PTR=NODE
  1902.  
  1903. C
  1904. C Going down
  1905. C
  1906. C  Substitute SUBNOD for REDNOD when latter encountered.
  1907. 100      IF (COMPAR(PTR,REDNOD) .EQ. -2) THEN
  1908.          CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  1909.          CALL YEXPR(SUBNOD,TKNCHN)
  1910.          CALL ZTOKWR(TRPARN,0,DUMMY,TKNCHN)
  1911.          GO TO 1000
  1912.       END IF
  1913.         DOWN=ZYDOWN(PTR)
  1914.         NTYPE=ZYNTYP(PTR)
  1915.         IF (DOWN.LE.0) THEN
  1916.             IF (NTYPE.NE.106) CALL YLEAF(PTR,TKNCHN)
  1917.             GOTO 1000
  1918.         END IF
  1919.         IF (NTYPE.EQ.97) THEN
  1920.             CALL ZTOKWR(TPLUS,0,DUMMY,TKNCHN)
  1921.         ELSE IF (NTYPE.EQ.46) THEN
  1922.             CALL ZTOKWR(TMINUS,0,DUMMY,TKNCHN)
  1923.         ELSE IF (NTYPE.EQ.101 .OR. NTYPE.EQ.102) THEN
  1924.             CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  1925.         ELSE IF (NTYPE.EQ.88) THEN
  1926.             CALL ZTOKWR(TNOT,0,DUMMY,TKNCHN)
  1927.         END IF
  1928.         PTR=DOWN
  1929.         GOTO 100
  1930. C
  1931. C Going up (or next if this isn't the last)
  1932. C
  1933.  1000   IF (PTR.EQ.NODE) RETURN
  1934.         UP=ZYUP(PTR)
  1935.         UPTYPE=ZYNTYP(UP)
  1936.         IF (UPTYPE.EQ.101) THEN
  1937.             CALL ZTOKWR(TRPARN,0,DUMMY,TKNCHN)
  1938.             PTR=UP
  1939.             GOTO 1000
  1940.         ELSE IF (UPTYPE.EQ.97 .OR. UPTYPE.EQ.46 .OR.
  1941.      +           UPTYPE.EQ.88) THEN
  1942.             PTR=UP
  1943.             GOTO 1000
  1944.         END IF
  1945.         NEXT=ZYNEXT(PTR)
  1946.         IF (NEXT.EQ.0) THEN
  1947.             IF (UPTYPE.EQ.119 .OR. UPTYPE.EQ.104 .OR.
  1948.      +          UPTYPE.EQ.102 .OR. UPTYPE.EQ.105) THEN
  1949. C Check for special case of no list (N_FUNREF only)
  1950.                 IF (ZYDOWN(UP).EQ.PTR)
  1951.      +              CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  1952.                 CALL ZTOKWR(TRPARN,0,DUMMY,TKNCHN)
  1953.             END IF
  1954.             PTR=UP
  1955.             GOTO 1000
  1956.         END IF
  1957. C NEXT.NE.0
  1958.         IF (UPTYPE.EQ.95) THEN
  1959.             CALL ZTOKWR(TPLUS,0,DUMMY,TKNCHN)
  1960.         ELSE IF (UPTYPE.EQ.96) THEN
  1961.             CALL ZTOKWR(TMINUS,0,DUMMY,TKNCHN)
  1962.         ELSE IF (UPTYPE.EQ.98) THEN
  1963.             CALL ZTOKWR(TSTAR,0,DUMMY,TKNCHN)
  1964.         ELSE IF (UPTYPE.EQ.99) THEN
  1965.             CALL ZTOKWR(TSLASH,0,DUMMY,TKNCHN)
  1966.         ELSE IF (UPTYPE.EQ.100) THEN
  1967.             CALL ZTOKWR(TDSTAR,0,DUMMY,TKNCHN)
  1968.         ELSE IF (UPTYPE.EQ.102) THEN
  1969.             CALL ZTOKWR(TCOMMA,0,DUMMY,TKNCHN)
  1970.         ELSE IF (UPTYPE.EQ.84) THEN
  1971.             CALL ZTOKWR(TEQV,0,DUMMY,TKNCHN)
  1972.         ELSE IF (UPTYPE.EQ.85) THEN
  1973.             CALL ZTOKWR(TNEQV,0,DUMMY,TKNCHN)
  1974.         ELSE IF (UPTYPE.EQ.87) THEN
  1975.             CALL ZTOKWR(TAND,0,DUMMY,TKNCHN)
  1976.         ELSE IF (UPTYPE.EQ.86) THEN
  1977.             CALL ZTOKWR(TOR,0,DUMMY,TKNCHN)
  1978.         ELSE IF (UPTYPE.EQ.70) THEN
  1979.             CALL ZTOKWR(TCNCAT,0,DUMMY,TKNCHN)
  1980.         ELSE IF (UPTYPE.EQ.90) THEN
  1981.             CALL ZTOKWR(TLE,0,DUMMY,TKNCHN)
  1982.         ELSE IF (UPTYPE.EQ.89) THEN
  1983.             CALL ZTOKWR(TLT,0,DUMMY,TKNCHN)
  1984.         ELSE IF (UPTYPE.EQ.93) THEN
  1985.             CALL ZTOKWR(TGT,0,DUMMY,TKNCHN)
  1986.         ELSE IF (UPTYPE.EQ.94) THEN
  1987.             CALL ZTOKWR(TGE,0,DUMMY,TKNCHN)
  1988.         ELSE IF (UPTYPE.EQ.91) THEN
  1989.             CALL ZTOKWR(TEQ,0,DUMMY,TKNCHN)
  1990.         ELSE IF (UPTYPE.EQ.92) THEN
  1991.             CALL ZTOKWR(TNE,0,DUMMY,TKNCHN)
  1992.         ELSE IF (UPTYPE.EQ.105) THEN
  1993.             CALL ZTOKWR(TCOLON,0,DUMMY,TKNCHN)
  1994.         ELSE
  1995. C Must be N_ARELM or N_FUNREF or N_SUBSTR
  1996.             IF (ZYDOWN(UP).EQ.PTR) THEN
  1997.                 CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  1998.             ELSE
  1999.                 CALL ZTOKWR(TCOMMA,0,DUMMY,TKNCHN)
  2000.             END IF
  2001.         END IF
  2002.         PTR=NEXT
  2003.         GOTO 100
  2004.  
  2005.         END
  2006. C--------   YEXPRU.MAC
  2007. C ----------------------------------------------------------------------
  2008. C
  2009. C       Y E X P R U  -   Output an expression
  2010. C
  2011.  
  2012.         SUBROUTINE YEXPRU(NODE,NAME,ICON,INCNOD,TKNCHN)
  2013.         INTEGER NODE,NAME(*),ICON(*),INCNOD,TKNCHN
  2014.  
  2015. C---------------------------------------------------------
  2016. C    TOOLPACK/1    Release: 2.1
  2017. C---------------------------------------------------------
  2018. C
  2019. C  TKLAST = LAST TOKEN NUMBER
  2020. C
  2021.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  2022.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  2023.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  2024.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  2025.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  2026.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  2027.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  2028.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  2029.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  2030.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  2031.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  2032.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  2033.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  2034.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  2035.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  2036.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  2037.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  2038.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  2039.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  2040.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  2041.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  2042.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  2043.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  2044.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  2045.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  2046.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  2047.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  2048.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  2049.  
  2050.  
  2051.         INTEGER PTR,DUMMY(2),UP,DOWN,NTYPE,NEXT,UPTYPE
  2052.  
  2053.         INTEGER ZYDOWN,ZYNEXT,ZYNTYP,ZYUP
  2054.         EXTERNAL ZYDOWN,ZYNEXT,ZYNTYP,ZTOKWR,ZYUP,YLEAFU
  2055.  
  2056.         DATA DUMMY(1)/129/
  2057.  
  2058.         PTR=NODE
  2059.  
  2060. C
  2061. C Going down
  2062. C
  2063.  100    DOWN=ZYDOWN(PTR)
  2064.         NTYPE=ZYNTYP(PTR)
  2065.         IF (DOWN.LE.0) THEN
  2066.             IF (NTYPE.NE.106)
  2067.      +         CALL YLEAFU(PTR,NAME,ICON,INCNOD,TKNCHN)
  2068.             GOTO 1000
  2069.         END IF
  2070.         IF (NTYPE.EQ.97) THEN
  2071.             CALL ZTOKWR(TPLUS,0,DUMMY,TKNCHN)
  2072.         ELSE IF (NTYPE.EQ.46) THEN
  2073.             CALL ZTOKWR(TMINUS,0,DUMMY,TKNCHN)
  2074.         ELSE IF (NTYPE.EQ.101 .OR. NTYPE.EQ.102) THEN
  2075.             CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  2076.         ELSE IF (NTYPE.EQ.88) THEN
  2077.             CALL ZTOKWR(TNOT,0,DUMMY,TKNCHN)
  2078.         END IF
  2079.         PTR=DOWN
  2080.         GOTO 100
  2081. C
  2082. C Going up (or next if this isn't the last)
  2083. C
  2084.  1000   IF (PTR.EQ.NODE) RETURN
  2085.         UP=ZYUP(PTR)
  2086.         UPTYPE=ZYNTYP(UP)
  2087.         IF (UPTYPE.EQ.101) THEN
  2088.             CALL ZTOKWR(TRPARN,0,DUMMY,TKNCHN)
  2089.             PTR=UP
  2090.             GOTO 1000
  2091.         ELSE IF (UPTYPE.EQ.97 .OR. UPTYPE.EQ.46 .OR.
  2092.      +           UPTYPE.EQ.88) THEN
  2093.             PTR=UP
  2094.             GOTO 1000
  2095.         END IF
  2096.         NEXT=ZYNEXT(PTR)
  2097.         IF (NEXT.EQ.0) THEN
  2098.             IF (UPTYPE.EQ.119 .OR. UPTYPE.EQ.104 .OR.
  2099.      +          UPTYPE.EQ.102 .OR. UPTYPE.EQ.105) THEN
  2100. C Check for special case of no list (N_FUNREF only)
  2101.                 IF (ZYDOWN(UP).EQ.PTR)
  2102.      +              CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  2103.                 CALL ZTOKWR(TRPARN,0,DUMMY,TKNCHN)
  2104.             END IF
  2105.             PTR=UP
  2106.             GOTO 1000
  2107.         END IF
  2108. C NEXT.NE.0
  2109.         IF (UPTYPE.EQ.95) THEN
  2110.             CALL ZTOKWR(TPLUS,0,DUMMY,TKNCHN)
  2111.         ELSE IF (UPTYPE.EQ.96) THEN
  2112.             CALL ZTOKWR(TMINUS,0,DUMMY,TKNCHN)
  2113.         ELSE IF (UPTYPE.EQ.98) THEN
  2114.             CALL ZTOKWR(TSTAR,0,DUMMY,TKNCHN)
  2115.         ELSE IF (UPTYPE.EQ.99) THEN
  2116.             CALL ZTOKWR(TSLASH,0,DUMMY,TKNCHN)
  2117.         ELSE IF (UPTYPE.EQ.100) THEN
  2118.             CALL ZTOKWR(TDSTAR,0,DUMMY,TKNCHN)
  2119.         ELSE IF (UPTYPE.EQ.102) THEN
  2120.             CALL ZTOKWR(TCOMMA,0,DUMMY,TKNCHN)
  2121.         ELSE IF (UPTYPE.EQ.84) THEN
  2122.             CALL ZTOKWR(TEQV,0,DUMMY,TKNCHN)
  2123.         ELSE IF (UPTYPE.EQ.85) THEN
  2124.             CALL ZTOKWR(TNEQV,0,DUMMY,TKNCHN)
  2125.         ELSE IF (UPTYPE.EQ.87) THEN
  2126.             CALL ZTOKWR(TAND,0,DUMMY,TKNCHN)
  2127.         ELSE IF (UPTYPE.EQ.86) THEN
  2128.             CALL ZTOKWR(TOR,0,DUMMY,TKNCHN)
  2129.         ELSE IF (UPTYPE.EQ.70) THEN
  2130.             CALL ZTOKWR(TCNCAT,0,DUMMY,TKNCHN)
  2131.         ELSE IF (UPTYPE.EQ.90) THEN
  2132.             CALL ZTOKWR(TLE,0,DUMMY,TKNCHN)
  2133.         ELSE IF (UPTYPE.EQ.89) THEN
  2134.             CALL ZTOKWR(TLT,0,DUMMY,TKNCHN)
  2135.         ELSE IF (UPTYPE.EQ.93) THEN
  2136.             CALL ZTOKWR(TGT,0,DUMMY,TKNCHN)
  2137.         ELSE IF (UPTYPE.EQ.94) THEN
  2138.             CALL ZTOKWR(TGE,0,DUMMY,TKNCHN)
  2139.         ELSE IF (UPTYPE.EQ.91) THEN
  2140.             CALL ZTOKWR(TEQ,0,DUMMY,TKNCHN)
  2141.         ELSE IF (UPTYPE.EQ.92) THEN
  2142.             CALL ZTOKWR(TNE,0,DUMMY,TKNCHN)
  2143.         ELSE IF (UPTYPE.EQ.105) THEN
  2144.             CALL ZTOKWR(TCOLON,0,DUMMY,TKNCHN)
  2145.         ELSE
  2146. C Must be N_ARELM or N_FUNREF or N_SUBSTR
  2147.             IF (ZYDOWN(UP).EQ.PTR) THEN
  2148.                 CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  2149.             ELSE
  2150.                 CALL ZTOKWR(TCOMMA,0,DUMMY,TKNCHN)
  2151.             END IF
  2152.         END IF
  2153.         PTR=NEXT
  2154.         GOTO 100
  2155.  
  2156.         END
  2157. C--------   YITEMN.MAC
  2158. C ----------------------------------------------------------------------
  2159. C
  2160. C       Y I T E M N   -   Output leaf/ardcl/arelm/substr
  2161. C
  2162.  
  2163.         SUBROUTINE YITEMN(NODE,NAME,REPNAM,ICON,INCNOD,TKNCHN)
  2164.         INTEGER NODE,NAME(*),REPNAM(*),ICON(*),INCNOD,TKNCHN
  2165.  
  2166. C---------------------------------------------------------
  2167. C    TOOLPACK/1    Release: 2.1
  2168. C---------------------------------------------------------
  2169. C
  2170. C  TKLAST = LAST TOKEN NUMBER
  2171. C
  2172.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  2173.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  2174.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  2175.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  2176.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  2177.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  2178.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  2179.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  2180.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  2181.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  2182.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  2183.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  2184.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  2185.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  2186.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  2187.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  2188.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  2189.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  2190.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  2191.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  2192.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  2193.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  2194.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  2195.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  2196.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  2197.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  2198.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  2199.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  2200.  
  2201.  
  2202.         INTEGER NTYPE,PTR,DUMMY(2)
  2203.         LOGICAL CHARA
  2204.  
  2205.         INTEGER ZYNTYP,ZYDOWN,ZYNEXT
  2206.         EXTERNAL ZYNTYP,ZYDOWN,ZYNEXT,YSUBST,YNRELM,YLEAF,YARDCL,YCHLEN
  2207.  
  2208.         DATA DUMMY(1)/129/
  2209.  
  2210.         NTYPE=ZYNTYP(NODE)
  2211.         IF (NTYPE.EQ.31) THEN
  2212.             CHARA=.TRUE.
  2213.             PTR=ZYDOWN(NODE)
  2214.             NTYPE=ZYNTYP(PTR)
  2215.         ELSE
  2216.             CHARA=.FALSE.
  2217.             PTR=NODE
  2218.         END IF
  2219.         IF (NTYPE.EQ.103) THEN
  2220.             CALL YSUBST(PTR,TKNCHN)
  2221.         ELSE IF (NTYPE.EQ.104) THEN
  2222.             CALL YNRELM(PTR,NAME,REPNAM,ICON,INCNOD,TKNCHN)
  2223.         ELSE IF (NTYPE.EQ.21) THEN
  2224.             CALL YLEAF(ZYDOWN(PTR),TKNCHN)
  2225.             CALL YARDCL(ZYNEXT(ZYDOWN(PTR)),TKNCHN)
  2226.         ELSE
  2227.             CALL YLEAF(PTR,TKNCHN)
  2228.         END IF
  2229.         IF (CHARA) CALL YCHLEN(-ZYNEXT(PTR),TKNCHN)
  2230.  
  2231.         END
  2232. C--------   YITEMS.MAC
  2233. C ----------------------------------------------------------------------
  2234. C
  2235. C       Y I T E M S   -   Output leaf/ardcl/arelm/substr
  2236. C
  2237.  
  2238.         SUBROUTINE YITEMS(NODE,REDNOD,SUBNOD,TKNCHN)
  2239.         INTEGER NODE,REDNOD,SUBNOD,TKNCHN
  2240.  
  2241. C---------------------------------------------------------
  2242. C    TOOLPACK/1    Release: 2.1
  2243. C---------------------------------------------------------
  2244. C
  2245. C  TKLAST = LAST TOKEN NUMBER
  2246. C
  2247.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  2248.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  2249.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  2250.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  2251.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  2252.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  2253.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  2254.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  2255.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  2256.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  2257.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  2258.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  2259.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  2260.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  2261.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  2262.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  2263.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  2264.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  2265.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  2266.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  2267.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  2268.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  2269.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  2270.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  2271.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  2272.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  2273.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  2274.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  2275.  
  2276.  
  2277.         INTEGER NTYPE,PTR,DUMMY(2)
  2278.         LOGICAL CHARA
  2279.  
  2280.         INTEGER ZYNTYP,ZYDOWN,ZYNEXT
  2281.         EXTERNAL ZYNTYP,ZYDOWN,ZYNEXT
  2282.  
  2283.         DATA DUMMY(1)/129/
  2284.  
  2285.         NTYPE=ZYNTYP(NODE)
  2286.         IF (NTYPE.EQ.31) THEN
  2287.             CHARA=.TRUE.
  2288.             PTR=ZYDOWN(NODE)
  2289.             NTYPE=ZYNTYP(PTR)
  2290.         ELSE
  2291.             CHARA=.FALSE.
  2292.             PTR=NODE
  2293.         END IF
  2294.         IF (NTYPE.EQ.103) THEN
  2295.             CALL YSUBST(PTR,TKNCHN)
  2296.         ELSE IF (NTYPE.EQ.104) THEN
  2297.             CALL YAELMS(PTR,REDNOD,SUBNOD,TKNCHN)
  2298.         ELSE IF (NTYPE.EQ.21) THEN
  2299.             CALL YLEAF(ZYDOWN(PTR),TKNCHN)
  2300.             CALL YARDCL(ZYNEXT(ZYDOWN(PTR)),TKNCHN)
  2301.         ELSE
  2302.             CALL YLEAF(PTR,TKNCHN)
  2303.         END IF
  2304.         IF (CHARA) CALL YCHLEN(-ZYNEXT(PTR),TKNCHN)
  2305.  
  2306.         END
  2307. C--------   YITEMU.MAC
  2308. C ----------------------------------------------------------------------
  2309. C
  2310. C       Y I T E M U   -   Output leaf/ardcl/arelm/substr
  2311. C
  2312.  
  2313.         SUBROUTINE YITEMU(NODE,NAME,ICON,INCNOD,TKNCHN)
  2314.         INTEGER NODE,NAME(*),ICON(*),INCNOD,TKNCHN
  2315.  
  2316. C---------------------------------------------------------
  2317. C    TOOLPACK/1    Release: 2.1
  2318. C---------------------------------------------------------
  2319. C
  2320. C  TKLAST = LAST TOKEN NUMBER
  2321. C
  2322.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  2323.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  2324.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  2325.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  2326.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  2327.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  2328.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  2329.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  2330.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  2331.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  2332.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  2333.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  2334.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  2335.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  2336.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  2337.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  2338.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  2339.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  2340.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  2341.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  2342.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  2343.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  2344.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  2345.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  2346.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  2347.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  2348.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  2349.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  2350.  
  2351.  
  2352.         INTEGER NTYPE,PTR,DUMMY(2)
  2353.         LOGICAL CHARA
  2354.  
  2355.         INTEGER ZYNTYP,ZYDOWN,ZYNEXT
  2356.         EXTERNAL ZYNTYP,ZYDOWN,ZYNEXT,YSUBST,YNRELU,YLEAF,YARDCL,YCHLEN
  2357.  
  2358.         DATA DUMMY(1)/129/
  2359.  
  2360.         NTYPE=ZYNTYP(NODE)
  2361.         IF (NTYPE.EQ.31) THEN
  2362.             CHARA=.TRUE.
  2363.             PTR=ZYDOWN(NODE)
  2364.             NTYPE=ZYNTYP(PTR)
  2365.         ELSE
  2366.             CHARA=.FALSE.
  2367.             PTR=NODE
  2368.         END IF
  2369.         IF (NTYPE.EQ.103) THEN
  2370.             CALL YSUBST(PTR,TKNCHN)
  2371.         ELSE IF (NTYPE.EQ.104) THEN
  2372.             CALL YNRELU(PTR,NAME,ICON,INCNOD,TKNCHN)
  2373.         ELSE IF (NTYPE.EQ.21) THEN
  2374.             CALL YLEAF(ZYDOWN(PTR),TKNCHN)
  2375.             CALL YARDCL(ZYNEXT(ZYDOWN(PTR)),TKNCHN)
  2376.         ELSE
  2377.             CALL YLEAF(PTR,TKNCHN)
  2378.         END IF
  2379.         IF (CHARA) CALL YCHLEN(-ZYNEXT(PTR),TKNCHN)
  2380.  
  2381.         END
  2382. C--------   YLEAFN.MAC
  2383. C ----------------------------------------------------------------------
  2384. C
  2385. C       Y L E A F N   -   Output the token for a leaf node
  2386. C                       Leaf nodes are: all names and constants,
  2387. C                                       and the "asterisk" node.
  2388. C
  2389.  
  2390.         SUBROUTINE YLEAFN(NODE,NAME,REPNAM,ICON,INCNOD,TKNCHN)
  2391.         INTEGER NODE,NAME(*),REPNAM(*),ICON(*),INCNOD,TKNCHN
  2392.  
  2393. C---------------------------------------------------------
  2394. C    TOOLPACK/1    Release: 2.1
  2395. C---------------------------------------------------------
  2396. C
  2397. C  TKLAST = LAST TOKEN NUMBER
  2398. C
  2399.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  2400.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  2401.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  2402.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  2403.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  2404.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  2405.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  2406.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  2407.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  2408.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  2409.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  2410.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  2411.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  2412.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  2413.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  2414.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  2415.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  2416.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  2417.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  2418.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  2419.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  2420.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  2421.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  2422.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  2423.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  2424.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  2425.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  2426.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  2427.  
  2428.  
  2429.         SAVE
  2430.  
  2431.         INTEGER TEXT(1322),SYMBOL(8),TOKTYP,NTYPE,
  2432.      +          ERRTXT(4),ENDTXT(4),DUMMY(2),CONONE(2),NUM1,VLICON
  2433.       LOGICAL NIXLRP
  2434.  
  2435.         INTEGER ZYNTYP,ZYDOWN,LENGTH,EQUAL,CTOI
  2436.       LOGICAL NOPARN
  2437.         EXTERNAL ZYNTYP,ZYDOWN,LENGTH,ZYGTSY,ZYGTST,ZTOKWR,ERROR,
  2438.      +           ZPTINT,ZCHOUT,EQUAL,ZTOCAP,ZMESS,YEXPR,CTOI,NOPARN
  2439.  
  2440.         DATA ERRTXT/69,82,82,129/,ENDTXT/69,78,68,129/
  2441.         DATA DUMMY(1) /129/
  2442.       DATA CONONE/49,129/
  2443.  
  2444.         NTYPE=ZYNTYP(NODE)
  2445.         IF (NTYPE.EQ.108 .OR. NTYPE.EQ.115 .OR.
  2446.      +      NTYPE.EQ.116 .OR. NTYPE.EQ.40) THEN
  2447.             TEXT(1)=129
  2448.             IF (NTYPE.EQ.40)
  2449.      +          CALL ZTOKWR(TSLASH,0,TEXT,TKNCHN)
  2450.             CALL ZYGTSY(-ZYDOWN(NODE),SYMBOL)
  2451.             CALL ZYGTST(SYMBOL(2),TEXT)
  2452.             IF (NTYPE.EQ.108 .OR. NTYPE.EQ.40) THEN
  2453.                 TOKTYP=TNAME
  2454.             ELSE
  2455.                 TOKTYP=TDCNST
  2456.             END IF
  2457.         ELSE IF (NTYPE.EQ.17) THEN
  2458.             TOKTYP=TSTAR
  2459.             TEXT(1)=129
  2460.         ELSE
  2461.             CALL ZYGTST(-ZYDOWN(NODE),TEXT)
  2462.             IF (NTYPE.EQ.107) THEN
  2463.                 TOKTYP=TDCNST
  2464.             ELSE IF (NTYPE.EQ.110) THEN
  2465.                 TOKTYP=TRCNST
  2466.             ELSE IF (NTYPE.EQ.111) THEN
  2467.                 TOKTYP=TPCNST
  2468.             ELSE IF (NTYPE.EQ.109) THEN
  2469.                 TOKTYP=TLCNST
  2470.             ELSE IF (NTYPE.EQ.114) THEN
  2471.                 TOKTYP=TCCNST
  2472.             ELSE IF (NTYPE.EQ.113) THEN
  2473.                 TOKTYP=THCNST
  2474.             ELSE IF (NTYPE.EQ.120) THEN
  2475.                 TOKTYP=TNAME
  2476.             ELSE IF (NTYPE.EQ.118) THEN
  2477.                 CALL ZTOCAP(TEXT)
  2478.                 IF (EQUAL(TEXT,ENDTXT).EQ.-2) THEN
  2479.                     TOKTYP=TENDKD
  2480.                 ELSE IF (EQUAL(TEXT,ERRTXT).EQ.-2) THEN
  2481.                     TOKTYP=TERRKD
  2482.                 ELSE
  2483.                     TOKTYP=TNAME
  2484.                 END IF
  2485.             ELSE
  2486.                 CALL ZCHOUT('YLEAFN: Invalid leaf node (Number .',2)
  2487.                 CALL ZPTINT(NODE,1,2)
  2488.                 CALL ZCHOUT(',type .',2)
  2489.                 CALL ZPTINT(NTYPE,1,2)
  2490.                 CALL ZMESS(').',2)
  2491.                 CALL ERROR('PROGRAM ABORTED.')
  2492.             END IF
  2493.         END IF
  2494.       IF(NTYPE .EQ. 108 .AND. EQUAL(TEXT,NAME) .EQ. -2) THEN
  2495.          NIXLRP = NOPARN(NODE)
  2496.            IF (.NOT. NIXLRP) CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  2497.          CALL ZTOKWR(TOKTYP,LENGTH(REPNAM),REPNAM,TKNCHN)
  2498. C Calculate the value of ICON so we can simplify the output when ICON = 0.
  2499.          NUM1 = 1
  2500.          VLICON = CTOI(ICON,NUM1)
  2501.          IF (VLICON .GT. 0) THEN
  2502.             IF (INCNOD .EQ. -1) THEN
  2503.                  CALL ZTOKWR(TMINUS,0,DUMMY,TKNCHN)
  2504.             ELSE
  2505.                  CALL ZTOKWR(TPLUS,0,DUMMY,TKNCHN)
  2506.             END IF
  2507.               CALL ZTOKWR(TDCNST,LENGTH(ICON),ICON,TKNCHN)
  2508.          END IF
  2509.          IF (INCNOD .GT. 0) THEN
  2510.               CALL ZTOKWR(TSTAR,0,DUMMY,TKNCHN)
  2511.               CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  2512.             CALL YEXPR(INCNOD,TKNCHN)
  2513.               CALL ZTOKWR(TRPARN,0,DUMMY,TKNCHN)
  2514.          END IF
  2515.            IF (.NOT. NIXLRP) CALL ZTOKWR(TRPARN,0,DUMMY,TKNCHN)
  2516.       ELSE
  2517.            CALL ZTOKWR(TOKTYP,LENGTH(TEXT),TEXT,TKNCHN)
  2518.       END IF
  2519.         IF (NTYPE.EQ.40) THEN
  2520.             TEXT(1)=129
  2521.             CALL ZTOKWR(TSLASH,0,TEXT,TKNCHN)
  2522.         END IF
  2523.  
  2524.         END
  2525. C--------   YLEAFU.MAC
  2526. C ----------------------------------------------------------------------
  2527. C
  2528. C       Y L E A F U   -   Output the token for a leaf node
  2529. C                       Leaf nodes are: all names and constants,
  2530. C                                       and the "asterisk" node.
  2531. C
  2532.  
  2533.         SUBROUTINE YLEAFU(NODE,NAME,ICON,INCNOD,TKNCHN)
  2534.         INTEGER NODE,NAME(*),ICON(*),INCNOD,TKNCHN
  2535.  
  2536. C---------------------------------------------------------
  2537. C    TOOLPACK/1    Release: 2.1
  2538. C---------------------------------------------------------
  2539. C
  2540. C  TKLAST = LAST TOKEN NUMBER
  2541. C
  2542.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  2543.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  2544.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  2545.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  2546.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  2547.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  2548.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  2549.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  2550.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  2551.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  2552.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  2553.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  2554.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  2555.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  2556.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  2557.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  2558.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  2559.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  2560.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  2561.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  2562.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  2563.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  2564.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  2565.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  2566.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  2567.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  2568.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  2569.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  2570.  
  2571.  
  2572.         SAVE
  2573.  
  2574.         INTEGER TEXT(1322),SYMBOL(8),TOKTYP,NTYPE,
  2575.      +          ERRTXT(4),ENDTXT(4),DUMMY(2)
  2576.       LOGICAL NIXLRP
  2577.  
  2578.         INTEGER ZYNTYP,ZYDOWN,LENGTH,EQUAL
  2579.       LOGICAL NOPARN
  2580.         EXTERNAL ZYNTYP,ZYDOWN,LENGTH,ZYGTSY,ZYGTST,ZTOKWR,ERROR,
  2581.      +           ZPTINT,ZCHOUT,EQUAL,ZTOCAP,ZMESS,YEXPR,NOPARN
  2582.  
  2583.         DATA ERRTXT/69,82,82,129/,ENDTXT/69,78,68,129/
  2584.         DATA DUMMY(1) /129/
  2585.  
  2586.         NTYPE=ZYNTYP(NODE)
  2587.         IF (NTYPE.EQ.108 .OR. NTYPE.EQ.115 .OR.
  2588.      +      NTYPE.EQ.116 .OR. NTYPE.EQ.40) THEN
  2589.             TEXT(1)=129
  2590.             IF (NTYPE.EQ.40)
  2591.      +          CALL ZTOKWR(TSLASH,0,TEXT,TKNCHN)
  2592.             CALL ZYGTSY(-ZYDOWN(NODE),SYMBOL)
  2593.             CALL ZYGTST(SYMBOL(2),TEXT)
  2594.             IF (NTYPE.EQ.108 .OR. NTYPE.EQ.40) THEN
  2595.                 TOKTYP=TNAME
  2596.             ELSE
  2597.                 TOKTYP=TDCNST
  2598.             END IF
  2599.         ELSE IF (NTYPE.EQ.17) THEN
  2600.             TOKTYP=TSTAR
  2601.             TEXT(1)=129
  2602.         ELSE
  2603.             CALL ZYGTST(-ZYDOWN(NODE),TEXT)
  2604.             IF (NTYPE.EQ.107) THEN
  2605.                 TOKTYP=TDCNST
  2606.             ELSE IF (NTYPE.EQ.110) THEN
  2607.                 TOKTYP=TRCNST
  2608.             ELSE IF (NTYPE.EQ.111) THEN
  2609.                 TOKTYP=TPCNST
  2610.             ELSE IF (NTYPE.EQ.109) THEN
  2611.                 TOKTYP=TLCNST
  2612.             ELSE IF (NTYPE.EQ.114) THEN
  2613.                 TOKTYP=TCCNST
  2614.             ELSE IF (NTYPE.EQ.113) THEN
  2615.                 TOKTYP=THCNST
  2616.             ELSE IF (NTYPE.EQ.120) THEN
  2617.                 TOKTYP=TNAME
  2618.             ELSE IF (NTYPE.EQ.118) THEN
  2619.                 CALL ZTOCAP(TEXT)
  2620.                 IF (EQUAL(TEXT,ENDTXT).EQ.-2) THEN
  2621.                     TOKTYP=TENDKD
  2622.                 ELSE IF (EQUAL(TEXT,ERRTXT).EQ.-2) THEN
  2623.                     TOKTYP=TERRKD
  2624.                 ELSE
  2625.                     TOKTYP=TNAME
  2626.                 END IF
  2627.             ELSE
  2628.                 CALL ZCHOUT('YLEAFU: Invalid leaf node (Number .',2)
  2629.                 CALL ZPTINT(NODE,1,2)
  2630.                 CALL ZCHOUT(',type .',2)
  2631.                 CALL ZPTINT(NTYPE,1,2)
  2632.                 CALL ZMESS(').',2)
  2633.                 CALL ERROR('PROGRAM ABORTED.')
  2634.             END IF
  2635.         END IF
  2636.       IF(NTYPE .EQ. 108 .AND. EQUAL(TEXT,NAME) .EQ. -2) THEN
  2637.          NIXLRP = NOPARN(NODE)
  2638.            IF (.NOT. NIXLRP) CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  2639.            CALL ZTOKWR(TOKTYP,LENGTH(TEXT),TEXT,TKNCHN)
  2640.          IF (INCNOD .EQ. -1) THEN
  2641.               CALL ZTOKWR(TMINUS,0,DUMMY,TKNCHN)
  2642.          ELSE
  2643.               CALL ZTOKWR(TPLUS,0,DUMMY,TKNCHN)
  2644.          END IF
  2645.            CALL ZTOKWR(TDCNST,LENGTH(ICON),ICON,TKNCHN)
  2646.          IF (INCNOD .GT. 0) THEN
  2647.               CALL ZTOKWR(TSTAR,0,DUMMY,TKNCHN)
  2648.               CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  2649.             CALL YEXPR(INCNOD,TKNCHN)
  2650.               CALL ZTOKWR(TRPARN,0,DUMMY,TKNCHN)
  2651.          END IF
  2652.            IF (.NOT. NIXLRP) CALL ZTOKWR(TRPARN,0,DUMMY,TKNCHN)
  2653.       ELSE
  2654.            CALL ZTOKWR(TOKTYP,LENGTH(TEXT),TEXT,TKNCHN)
  2655.       END IF
  2656.         IF (NTYPE.EQ.40) THEN
  2657.             TEXT(1)=129
  2658.             CALL ZTOKWR(TSLASH,0,TEXT,TKNCHN)
  2659.         END IF
  2660.  
  2661.         END
  2662. C--------   YNRELM.MAC
  2663. C ----------------------------------------------------------------------
  2664. C
  2665. C       Y N R E L M   -   Output token stream for an array_element_name
  2666. C
  2667.  
  2668.         SUBROUTINE YNRELM(NODE,NAME,REPNAM,ICON,INCNOD,TKNCHN)
  2669.         INTEGER NODE,NAME(*),REPNAM(*),ICON(*),INCNOD,TKNCHN
  2670.  
  2671. C---------------------------------------------------------
  2672. C    TOOLPACK/1    Release: 2.1
  2673. C---------------------------------------------------------
  2674. C
  2675. C  TKLAST = LAST TOKEN NUMBER
  2676. C
  2677.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  2678.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  2679.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  2680.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  2681.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  2682.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  2683.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  2684.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  2685.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  2686.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  2687.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  2688.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  2689.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  2690.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  2691.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  2692.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  2693.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  2694.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  2695.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  2696.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  2697.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  2698.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  2699.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  2700.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  2701.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  2702.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  2703.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  2704.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  2705.  
  2706.  
  2707.         INTEGER PTR,DUMMY(2)
  2708.  
  2709.         INTEGER ZYDOWN,ZYNEXT,LENGTH
  2710.         EXTERNAL ZYDOWN,ZYNEXT,LENGTH,ZTOKWR,YLEAF,YEXPRN
  2711.  
  2712.         DATA DUMMY(1)/129/
  2713.  
  2714.         PTR=ZYDOWN(NODE)
  2715.         CALL YLEAF(PTR,TKNCHN)
  2716.         CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  2717.         PTR=ZYNEXT(PTR)
  2718.  
  2719.  100    CALL YEXPRN(PTR,NAME,REPNAM,ICON,INCNOD,TKNCHN)
  2720.         PTR=ZYNEXT(PTR)
  2721.         IF (PTR.GT.0) THEN
  2722.             CALL ZTOKWR(TCOMMA,0,DUMMY,TKNCHN)
  2723.             GOTO 100
  2724.         END IF
  2725.         CALL ZTOKWR(TRPARN,0,DUMMY,TKNCHN)
  2726.  
  2727.         END
  2728. C--------   YNRELU.MAC
  2729. C ----------------------------------------------------------------------
  2730. C
  2731. C       Y N R E L U   -   Output token stream for an array_element_name
  2732. C
  2733.  
  2734.         SUBROUTINE YNRELU(NODE,NAME,ICON,INCNOD,TKNCHN)
  2735.         INTEGER NODE,NAME(*),ICON(*),INCNOD,TKNCHN
  2736.  
  2737. C---------------------------------------------------------
  2738. C    TOOLPACK/1    Release: 2.1
  2739. C---------------------------------------------------------
  2740. C
  2741. C  TKLAST = LAST TOKEN NUMBER
  2742. C
  2743.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  2744.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  2745.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  2746.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  2747.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  2748.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  2749.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  2750.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  2751.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  2752.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  2753.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  2754.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  2755.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  2756.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  2757.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  2758.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  2759.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  2760.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  2761.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  2762.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  2763.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  2764.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  2765.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  2766.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  2767.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  2768.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  2769.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  2770.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  2771.  
  2772.  
  2773.         INTEGER PTR,DUMMY(2)
  2774.  
  2775.         INTEGER ZYDOWN,ZYNEXT,LENGTH
  2776.         EXTERNAL ZYDOWN,ZYNEXT,LENGTH,ZTOKWR,YLEAF,YEXPRU
  2777.  
  2778.         DATA DUMMY(1)/129/
  2779.  
  2780.         PTR=ZYDOWN(NODE)
  2781.         CALL YLEAF(PTR,TKNCHN)
  2782.         CALL ZTOKWR(TLPARN,0,DUMMY,TKNCHN)
  2783.         PTR=ZYNEXT(PTR)
  2784.  
  2785.  100    CALL YEXPRU(PTR,NAME,ICON,INCNOD,TKNCHN)
  2786.         PTR=ZYNEXT(PTR)
  2787.         IF (PTR.GT.0) THEN
  2788.             CALL ZTOKWR(TCOMMA,0,DUMMY,TKNCHN)
  2789.             GOTO 100
  2790.         END IF
  2791.         CALL ZTOKWR(TRPARN,0,DUMMY,TKNCHN)
  2792.  
  2793.         END
  2794. C--------   YSTMTS.MAC
  2795. C ----------------------------------------------------------------------
  2796. C
  2797. C       Y S T M T S   -   Output an assignment statement containing an
  2798. C                    occurrence of a subtree rooted at REDNOD on
  2799. C                    the rhs is so that the output otherwise taken
  2800. C                     from REDNOD is taken instead from the subtree
  2801. C                    rooted at SUBNOD.
  2802. C
  2803.  
  2804.         SUBROUTINE YSTMTS(NODE,REDNOD,SUBNOD,TKNCHN)
  2805.         INTEGER NODE,REDNOD,SUBNOD,TKNCHN
  2806.  
  2807.         INTEGER STYPE,PTR,DUMMY(2)
  2808.  
  2809. C---------------------------------------------------------
  2810. C    TOOLPACK/1    Release: 2.1
  2811. C---------------------------------------------------------
  2812. C
  2813. C  TKLAST = LAST TOKEN NUMBER
  2814. C
  2815.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  2816.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  2817.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  2818.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  2819.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  2820.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  2821.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  2822.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  2823.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  2824.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  2825.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  2826.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  2827.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  2828.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  2829.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  2830.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  2831.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  2832.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  2833.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  2834.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  2835.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  2836.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  2837.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  2838.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  2839.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  2840.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  2841.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  2842.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  2843.  
  2844.  
  2845.         INTEGER ZYNTYP,ZYDOWN,ZYNEXT
  2846.         EXTERNAL ZYNTYP,ZYDOWN,ZYNEXT,ZTOKWR,YLEAF,XSASGN,ERROR
  2847.  
  2848.         DATA DUMMY(1)/129/
  2849.  
  2850.         PTR=NODE
  2851.         STYPE=ZYNTYP(PTR)
  2852.         PTR=ZYDOWN(PTR)
  2853.         IF (PTR.NE.0) THEN
  2854.             IF (ZYNTYP(PTR).EQ.115) THEN
  2855.                 CALL YLEAF(PTR,TKNCHN)
  2856.                 PTR=ZYNEXT(PTR)
  2857.             END IF
  2858.         END IF
  2859.         IF (STYPE.EQ.49) THEN
  2860.             CALL XSASGN(PTR,REDNOD,SUBNOD,TKNCHN)
  2861.         ELSE
  2862.             CALL ERROR('YSTMTS: Not An Assignment Statement.')
  2863.         END IF
  2864.         CALL ZTOKWR(TZEOS,0,DUMMY,TKNCHN)
  2865.  
  2866.         END
  2867.